raw_data <- read.csv("hotel_data.csv")
glimpse(raw_data)
## Observations: 193,624
## Variables: 19
## $ MNEMONIC_CD <fct> GLWST, GLWST, GLWST, GLWST, GLWST, GLWST, GLWS…
## $ stay_date <fct> 5/1/2008, 5/1/2008, 5/1/2008, 5/1/2008, 5/1/20…
## $ CONF_DT <fct> 8-Nov-07, 6-Jan-08, 9-Jan-08, 9-Jan-08, 9-Jan-…
## $ checkin_date <fct> 4/28/2008, 4/27/2008, 4/30/2008, 4/30/2008, 4/…
## $ RATE_CATEGORY_CD <fct> IGCOR, IGCOR, IDEX1, IDEX1, IDEX1, IKTURJAC, I…
## $ RM_TYP <fct> OSBN, OSBN, OSBN, OSBN, OSBN, OSBN, OSBN, TTWN…
## $ accom_rm_qty <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1…
## $ accom_nt_qty <int> 4, 6, 2, 2, 2, 1, 1, 2, 2, 2, 2, 1, 3, 3, 3, 3…
## $ lead_nt_qty <int> 172, 112, 112, 112, 112, 113, 80, 67, 63, 58, …
## $ no_of_bookings <int> 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1…
## $ STY_DT_RM_REV_AMT <dbl> 58, 69, 79, 79, 79, 47, 79, 69, 69, 42, 69, 48…
## $ sty_dt_rm_rate <dbl> 58, 69, 79, 79, 79, 47, 79, 69, 69, 42, 69, 48…
## $ room_nts <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1…
## $ MKT_CATEGORY_CD <fct> IGCOR, IGCOR, IDEX1, IDEX1, IDEX1, IKTUR, IGCO…
## $ CHAIN_SEGMENT_CD <fct> UNF_RM_FLX, UNF_RM_FLX, TACT_MKTG_BR_REG_CLSD,…
## $ SUB_SEGMENT_CD <fct> UN_FEN_RM, UN_FEN_RM, TACT_MKTG_BR_REG, TACT_M…
## $ SALES_SEGMENT_CD <fct> UN_FEN, UN_FEN, TACT_MKTG, TACT_MKTG, TACT_MKT…
## $ ACCESS_SEGMENT_CD <fct> PUB_RT, PUB_RT, CLSD_OFF, CLSD_OFF, CLSD_OFF, …
## $ MKT_SEGMENT_CD <fct> IND_TRANS, IND_TRANS, IND_TRANS, IND_TRANS, IN…
# select column with interest
columns <- c("MNEMONIC_CD", "stay_date", "CONF_DT","accom_rm_qty")
booking_data <- raw_data[columns] %>%
mutate(stay_date=mdy(stay_date),
CONF_DT = dmy(CONF_DT)) %>%
dplyr::rename(hotel= MNEMONIC_CD) %>%
group_by(hotel, stay_date, CONF_DT) %>%
summarise(bookings = sum(accom_rm_qty)) %>% ungroup() %>%
group_by(hotel, stay_date) %>%
mutate(max_b_date=stay_date, min_b_date=min(CONF_DT)) %>% ungroup()
# create fill in dataset
GLWST <- data.frame(hotel = 'GLWST', CONF_DT = seq.Date(from = as.Date("2007-06-27",format = "%Y-%m-%d"), by = "day", length.out = 1039))
MLKEP <- data.frame(hotel = 'MLKEP', CONF_DT = seq.Date(from = as.Date("2007-06-27",format = "%Y-%m-%d"), by = "day", length.out = 1039))
WARUK <- data.frame(hotel = 'WARUK', CONF_DT = seq.Date(from = as.Date("2007-06-27",format = "%Y-%m-%d"), by = "day", length.out = 1039))
merge_data <- rbind(GLWST,MLKEP ) %>% rbind(WARUK)
GLWST <- data.frame(hotel = 'GLWST', stay_date = seq.Date(from = as.Date("2008-05-01",format = "%Y-%m-%d"), by = "day", length.out = 730))
MLKEP <- data.frame(hotel = 'MLKEP', stay_date = seq.Date(from = as.Date("2008-05-01",format = "%Y-%m-%d"), by = "day", length.out = 730))
WARUK <- data.frame(hotel = 'WARUK', stay_date= seq.Date(from = as.Date("2008-05-01",format = "%Y-%m-%d"), by = "day", length.out = 730))
merge_data1 <- rbind(GLWST,MLKEP ) %>% rbind(WARUK)
merge_dataset <- merge(merge_data, merge_data1, by ="hotel", all = TRUE) %>% filter(stay_date >= CONF_DT )
# merge fill in dataset with booking dataset
booking_data_merge <- booking_data %>% select (c(hotel,stay_date,max_b_date,min_b_date)) %>% distinct()
booking_data_merge2 <- booking_data %>% select (c(hotel,stay_date,CONF_DT,bookings))
data_1 <- left_join(merge_dataset, booking_data_merge, by = c("hotel", "stay_date"))
filled_data <- left_join(data_1 , booking_data_merge2, by = c("hotel", "stay_date","CONF_DT")) %>%
filter(CONF_DT <= max_b_date & CONF_DT >= min_b_date ) %>%
mutate(bookings = replace_na(bookings, 0))
# create days_prior,bookings,cum_bookings,DOW,month,week, rate colum for later analysis
filled_data_full <- filled_data %>%
arrange(hotel,stay_date,CONF_DT) %>%
group_by(hotel, stay_date) %>%
mutate(cum_bookings = cumsum(bookings),
final_arrivals=max(cum_bookings),
rate = cum_bookings/final_arrivals,
add = final_arrivals - cum_bookings) %>% ungroup() %>%
mutate(year = year(stay_date),
week = week(stay_date),
month = zoo::as.yearmon(stay_date,label = TRUE),
quarter = zoo::as.yearqtr(stay_date,label = TRUE),
DOW = wday(stay_date,label = TRUE),
days_prior = as.numeric(difftime(stay_date, CONF_DT, units = "days"))) %>%
mutate(days_prior_c = ifelse(days_prior >= 1 & days_prior <= 7, '1 to 7',
ifelse(days_prior >= 8 & days_prior <= 14, '8 to 14',
ifelse(days_prior >= 15 & days_prior <= 21, '15 to 21',
ifelse(days_prior >= 22 & days_prior <= 28, '22 to 28',
ifelse(days_prior >= 29 & days_prior <= 59, '29 to 60', '60 or more')))))) %>%
mutate(days_prior_c = as.factor(days_prior_c))
# split data set into training and test parts with test sets for last 6 months(2009-11-1 to 2010-4-30)
training_data <- filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
test_data <- filled_data_full %>% filter(stay_date >= '2009-11-1') # 2009-11-1 to 2010-4-30
c0 <- training_data %>% filter(days_prior <= 90) %>%
group_by(hotel, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking)) +
geom_point(aes(color= hotel)) +
ggtitle("Booking curve by days prior of arrival and by hotel") +
xlab("days prior to arrival") + ylab("arrivals_rate")+
labs(color = "Hotel")+
theme_minimal()
c0
Observations
# hotel GLWST
c1 <- training_data %>% filter (hotel == "GLWST") %>% filter(days_prior <= 90) %>%
group_by(DOW, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = DOW)) +
geom_line() +
ggtitle("GLWST booking curve by DOW")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c1
# hotel MLKEP
c2 <- training_data %>% filter (hotel == "MLKEP") %>% filter(days_prior <= 90) %>%
group_by(DOW, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = DOW)) +
geom_line() +
ggtitle("MLKEP booking curve by DOW") +
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c2
# hotel WARUK
c3 <- training_data %>% filter (hotel == "WARUK") %>% filter(days_prior <= 90) %>%
group_by(DOW, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = DOW)) +
geom_line() +
ggtitle("WARUK booking curve by DOW") +
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c3
Observations
hotel GLWST: the highest demand occurs on Saturday and demands was realized early in time.
hotel MLKEP: the highest demand occurs on Tuesday and Wednesday.
hotel WARUK: the highest demand occurs on Tuesday and Wednesday and demands on Saturday was realized at faster pace.
c1 <- training_data %>% mutate(month=as.factor(month)) %>% filter (hotel == "GLWST") %>%
filter(days_prior <= 90) %>%
group_by(month, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = month)) +
geom_line() +
ggtitle("GLWST booking curve by yearmonth")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c1
c2 <- training_data %>% mutate(month=as.factor(month)) %>% filter (hotel == "MLKEP") %>%
filter(days_prior <= 90) %>%
group_by(month, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = month)) +
geom_line() +
ggtitle("MLKEP booking curve by yearmonth")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c2
c3 <- training_data %>% mutate(month=as.factor(month)) %>% filter (hotel == "WARUK") %>%
filter(days_prior <= 90) %>%
group_by(month, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = month)) +
geom_line() +
ggtitle("WARUK booking curve by yearmonth")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c3
c1 <- training_data %>% mutate(quarter=as.factor(quarter)) %>% filter (hotel == "GLWST") %>%
filter(days_prior <= 90) %>%
group_by(quarter, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = quarter)) +
geom_line() +
ggtitle("GLWST booking curve by yearquarter")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c1
c2 <- training_data %>% mutate(quarter=as.factor(quarter)) %>% filter (hotel == "MLKEP") %>%
filter(days_prior <= 90) %>%
group_by(quarter, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = quarter)) +
geom_line() +
ggtitle("MLKEP booking curve by yearquarter")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c2
c3 <- training_data %>% mutate(quarter=as.factor(quarter)) %>% filter (hotel == "WARUK") %>%
filter(days_prior <= 90) %>%
group_by(quarter, days_prior) %>%
summarise(avg_booking = mean(rate)) %>%
ggplot(aes(x = days_prior,y = avg_booking,color = quarter)) +
geom_line() +
ggtitle("WARUK booking curve by yearquarter")+
xlab("days prior to arrival") + ylab("arrivals_rate") +
theme_minimal()
c3
# select the final stay day
GLWST_training_ts <- training_data %>%
filter (hotel == "GLWST", days_prior == 0)
MLKEP_training_ts <- training_data %>%
filter (hotel == "MLKEP", days_prior == 0)
WARUK_training_ts <- training_data %>%
filter (hotel == "WARUK", days_prior == 0)
# time series data with daily frequency by hotel
GLWST_training_d.ts <- ts(GLWST_training_ts[,8],start = c(2008,122) ,frequency =365)
MLKEP_training_d.ts <- ts(MLKEP_training_ts[,8],start = c(2008,122) ,frequency =365)
WARUK_training_d.ts <- ts(WARUK_training_ts[,8],start = c(2008,122) ,frequency =365)
# time series data with weekly frequency by hotel
# aggreate the weekly data by hotel
GLWST_training_ts_w <- GLWST_training_ts %>% group_by(hotel, year,week) %>% summarise(avg_arrivals=mean(final_arrivals))%>% ungroup()
MLKEP_training_ts_w <- MLKEP_training_ts %>% group_by(hotel, year,week) %>% summarise(avg_arrivals=mean(final_arrivals))%>% ungroup()
WARUK_training_ts_w <- WARUK_training_ts %>% group_by(hotel, year,week) %>% summarise(avg_arrivals=mean(final_arrivals))%>% ungroup()
GLWST_training_w.ts <- ts(GLWST_training_ts_w[,4],start = c(2008,18) ,frequency = 53)
MLKEP_training_w.ts <- ts(MLKEP_training_ts_w[,4],start = c(2008,18) ,frequency = 53)
WARUK_training_w.ts <- ts(WARUK_training_ts_w[,4],start = c(2008,18) ,frequency = 53)
# time series data with monthly frequency by hotel
# aggreate the monthly data by hotel
GLWST_training_ts_m <- GLWST_training_ts %>% group_by(hotel, month) %>% summarise(avg_arrivals= mean(final_arrivals))%>% ungroup()
MLKEP_training_ts_m <- MLKEP_training_ts %>% group_by(hotel, month) %>% summarise(avg_arrivals= mean(final_arrivals))%>% ungroup()
WARUK_training_ts_m<- WARUK_training_ts %>% group_by(hotel, month) %>% summarise(avg_arrivals= mean(final_arrivals))%>% ungroup()
GLWST_training_m.ts <- ts(GLWST_training_ts_m[,3],start = c(2008,5) ,frequency =12)
MLKEP_training_m.ts <- ts(MLKEP_training_ts_m[,3],start = c(2008,5) ,frequency =12)
WARUK_training_m.ts <- ts(WARUK_training_ts_m[,3],start = c(2008,5) ,frequency =12)
# time series data with quarterly frequency by hotel
# aggreate the weekly data by hotel
GLWST_training_ts_q <- GLWST_training_ts %>% group_by(hotel, quarter) %>% summarise(avg_arrivals=mean(final_arrivals))%>% ungroup()
MLKEP_training_ts_q <- MLKEP_training_ts %>% group_by(hotel, quarter) %>% summarise(avg_arrivals=mean(final_arrivals))%>% ungroup()
WARUK_training_ts_q <- WARUK_training_ts %>% group_by(hotel, quarter) %>% summarise(avg_arrivals=mean(final_arrivals))%>% ungroup()
GLWST_training_q.ts <- ts(GLWST_training_ts_q[,3],start = c(2008,2) ,frequency = 4)
MLKEP_training_q.ts <- ts(MLKEP_training_ts_q[,3],start = c(2008,2) ,frequency = 4)
WARUK_training_q.ts <- ts(WARUK_training_ts_q[,3],start = c(2008,2) ,frequency = 4)
grid.arrange(
p1 <- GLWST_training_ts %>%
ggplot(aes(x = stay_date, y =final_arrivals)) +
geom_line(col='blue') +
xlab("stay_date GLWST")+
scale_y_log10() + theme_minimal(),
p2 <- MLKEP_training_ts %>%
ggplot(aes(x = stay_date,y = final_arrivals)) +
geom_line(col='green') +
xlab("stay_date MLKEP") + theme_minimal()+
scale_y_log10(),
p3 <- WARUK_training_ts %>%
ggplot(aes(x = stay_date,y = final_arrivals)) +
geom_line(col='red') +
xlab("stay_date WARUK")+ theme_minimal()+
scale_y_log10(),
ncol=1,
top = textGrob("Daily bookings by hotel",gp=gpar(fontsize=20,font=3))
)
Observations
time plot of all three hotels show a downward trend at the year end of 2008 and begining of 2009. this decrease in demand could be due to the financial crisis occured at that time.
the overall pattern of GLWST hotel(blue curve) time plot looks irregular and random and the up and down pattern of other two hotels look more regular.
ggAcf(GLWST_training_d.ts,main = "GLWST daily bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(GLWST_training_d.ts,main = "GLWST daily bookings Time Series ACF",lag.max = 32)
## Warning: Ignoring unknown parameters: main
ggAcf(GLWST_training_d.ts,main = "GLWST daily bookings Time Series ACF",lag.max = 200)
## Warning: Ignoring unknown parameters: main
ggAcf(MLKEP_training_d.ts,main = "MLKEP daily bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(MLKEP_training_d.ts,main = "MLKEP daily bookings Time Series ACF",lag.max = 32)
## Warning: Ignoring unknown parameters: main
ggAcf(MLKEP_training_d.ts,main = "MLKEP daily bookings Time Series ACF",lag.max = 200)
## Warning: Ignoring unknown parameters: main
ggAcf(WARUK_training_d.ts,main = "WARUK daily bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(WARUK_training_d.ts,main = "WARUK daily bookings Time Series ACF",lag.max = 32)
## Warning: Ignoring unknown parameters: main
ggAcf(WARUK_training_d.ts,main = "WARUK daily bookings Time Series ACF",lag.max = 200)
## Warning: Ignoring unknown parameters: main
Observations
there is DOW seasoanlity occurs in all hotel graphs
for hotel GLWST, when we set the lag.max = 30, we see a repeated pattern every 7, 14, 20 days. There is more randomness in the graph compare to the other two hotels
compare to hotel GLWST, hotel MLKEP and WARUK show a cyclic pattern
p1 <- training_data %>%
group_by(hotel, DOW) %>%
summarise(arrivals = mean(final_arrivals)) %>%
ggplot(aes(DOW, arrivals, fill = DOW)) +
geom_col() +
ggtitle("Average bookings by DOW by hotel") +
theme(legend.position = "none",axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "Day of Week", y = "Average arrivals") +
facet_wrap(~ hotel)
p1
Observations
hotel GLWST: the bookings are less varied by day of week. Saturday has slightly higher demands.
hotel MLKEP: the highest demand occurs on Tuesday and Wednesday
hotel WARUK: the highest demand occurs on Tuesday, Wednesday and Saturday
grid.arrange(
autoplot(GLWST_training_w.ts)+
ggtitle("GLWST")+
xlab("week")+
ylab("bookings"),
autoplot(MLKEP_training_w.ts)+
ggtitle("MLKEP")+
xlab("week")+
ylab("bookings"),
autoplot(WARUK_training_w.ts)+
ggtitle("WARUK") +
xlab("week")+
ylab("bookings"),
top = textGrob("Weekly bookings by hotel",gp=gpar(fontsize=20,font=3))
)
Observations
the lower demand at 2008 year end and beigining of 2009 are apparent in these graphs
correlogram and lag plot
gglagplot(GLWST_training_w.ts,main = "GLWST Lagged scatterplots for weekly bookings.")
gglagplot(MLKEP_training_w.ts,main = "MLKEP Lagged scatterplots for weekly bookings.")
gglagplot(WARUK_training_w.ts,main = "WARUK Lagged scatterplots for weekly bookings.")
ggAcf(GLWST_training_w.ts,main = "GLWST weekly bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(MLKEP_training_w.ts,main = "MLKEP weekly bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(WARUK_training_w.ts,main = "WARUK weekly bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
Observations
ggseasonplot(GLWST_training_w.ts , year.labels=TRUE, year.labels.left=TRUE) +
ylab("arrivals") +
ggtitle("GLWST Seasonal plot: weekly arrivals")
ggseasonplot(MLKEP_training_w.ts , year.labels=TRUE, year.labels.left=TRUE) +
ylab("arrivals") +
ggtitle("MLKEP Seasonal plot: weekly arrivals")
ggseasonplot(WARUK_training_w.ts , year.labels=TRUE, year.labels.left=TRUE) +
ylab("arrivals") +
ggtitle("WARUK Seasonal plot: weekly arrivals")
Observations
grid.arrange(
autoplot(GLWST_training_m.ts)+
ggtitle("GLWST") +
xlab("month")+
ylab("bookings"),
autoplot(MLKEP_training_m.ts)+
ggtitle("MLKEP") +
xlab("month")+
ylab("bookings"),
autoplot(WARUK_training_m.ts)+
ggtitle("WARUK") +
xlab("month")+
ylab("bookings"),
top = textGrob("Monthly bookings by hotel",gp=gpar(fontsize=20,font=3))
)
gglagplot(GLWST_training_m.ts,main = "GLWST Lagged scatterplots for monthly bookings.")
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
gglagplot(MLKEP_training_m.ts,main = "MLKEP Lagged scatterplots for monthly bookings.")
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
gglagplot(WARUK_training_m.ts,main = "WARUK Lagged scatterplots for monthly bookings.")
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
ggAcf(GLWST_training_m.ts,main = "GLWST monthly bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(MLKEP_training_m.ts,main = "MLKEP monthly bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggAcf(WARUK_training_m.ts,main = "WARUK monthly bookings Time Series ACF")
## Warning: Ignoring unknown parameters: main
ggseasonplot(GLWST_training_m.ts , year.labels=TRUE, year.labels.left=TRUE) +
ylab("arrivals") +
ggtitle("GLWST Seasonal plot: monthly arrivals")
ggseasonplot(MLKEP_training_m.ts , year.labels=TRUE, year.labels.left=TRUE) +
ylab("arrivals") +
ggtitle("MLKEP Seasonal plot: monthly arrivals")
ggseasonplot(WARUK_training_m.ts , year.labels=TRUE, year.labels.left=TRUE) +
ylab("arrivals") +
ggtitle("WARUK Seasonal plot: monthly arrivals")
Observations
for hotel GLWST, the overlapped parts (May - October) show are similar demands for 2008 and 2009, however, for hotel MLKEP, compared to year 2008, there are higher demands in May, June, July and August in 2009 and lower demands in September and October in 2009
for hotel WARUK, the demands from May to October are lower in 2009 than 2008
p1 <- training_data %>% mutate(month = as.factor(month(month,label=TRUE))) %>%
group_by(hotel, month) %>%
summarise(arrivals = mean(final_arrivals)) %>%
ggplot(aes(month, arrivals, fill = month)) +
geom_col() +
theme(legend.position = "none", axis.text.x = element_text(angle=60, hjust=1, vjust=0.9)) +
labs(title = "Average bookings by month by hotel", x = "Month of the year", y = "Average arrivals") +
facet_wrap(~ hotel)
p1
Observations
there is less variations in hotel GLWST’s monthly demands, January has the lowest bookings
for hotel MLKEP, January also has the lowest bookings, the most bookings are in September 2008 and June 2009
for hotel WARUK, January has the lowest bookings
ggAcf(GLWST_training_q.ts)
ggAcf(MLKEP_training_q.ts)
ggAcf(WARUK_training_q.ts)
p1 <- training_data %>% mutate(quarter = as.factor(quarter(quarter))) %>%
group_by(hotel, quarter) %>%
summarise(arrivals = mean(final_arrivals)) %>%
ggplot(aes(quarter, arrivals, fill = quarter)) +
geom_col() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(title = "Average bookings by quarter by hotel",x = "Quarter of the year", y = "Average arrivals") +
facet_wrap(~ hotel)
p1
Observations
# booking days prior - box plot
grid.arrange(
box1 <- training_data %>%
ggplot(aes(x=hotel, y = days_prior)) +
geom_boxplot(),
box2 <- training_data %>%
ggplot(aes(x = DOW, y = days_prior)) +
geom_boxplot() + facet_grid(. ~ hotel) + coord_flip(),
box3 <- training_data %>%
ggplot(aes(x = DOW, y = days_prior)) +
geom_boxplot() + facet_grid(. ~ hotel) + coord_flip(),
ncol = 2)
grid.arrange (
d1 <- GLWST_training_ts %>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_GLWST") +
facet_grid(. ~ DOW),
d2 <- MLKEP_training_ts %>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_MLKEP") +
facet_grid(. ~ DOW),
d3 <- WARUK_training_ts %>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_WARUK") +
facet_grid(. ~ DOW) ,
ncol=1)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Observations
for hotel GLWST, the demands are more concentrated on Saturdays, this will yield a more accurate forecasting result
for the other hotels, demands are spread out by DOW
grid.arrange (
d1 <- GLWST_training_ts %>% mutate(month = as.factor(month(month,label = TRUE)))%>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=90, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_GLWST") +
facet_grid(. ~ month),
d2 <- MLKEP_training_ts %>% mutate(month = as.factor(month(month,label = TRUE)))%>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=90, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_MLKEP") +
facet_grid(. ~ month),
d3 <- WARUK_training_ts %>% mutate(month = as.factor(month(month,label = TRUE)))%>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=90, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_WARUK") +
facet_grid(. ~ month),
ncol=1)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
grid.arrange (
d1 <- GLWST_training_ts %>% mutate(quarter = as.factor(quarter)) %>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_GLWST") +
facet_grid(. ~ quarter),
d2 <- MLKEP_training_ts %>% mutate(quarter = as.factor(quarter)) %>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_MLKEP") +
facet_grid(. ~ quarter),
d3 <- WARUK_training_ts %>% mutate(quarter = as.factor(quarter)) %>%
ggplot(aes(final_arrivals)) +
geom_histogram() +
theme(legend.position = "none", axis.text.x = element_text(angle=45, hjust=1, vjust=0.9)) +
labs(x = "final_arrivals_WARUK") +
facet_grid(. ~ quarter) ,
ncol=1)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
### model1: simple mean additive and multiplicative model by days prior
training_dataset <- training_data %>%
mutate(month = month(month)) %>%
group_by(hotel,days_prior) %>%
mutate (avg_add = mean(add), # average remaining bookings by hotel and days prior
avg_rate = mean(rate), # average daily rate by hotel and days prior
fc_add = (cum_bookings + avg_add), # forecast using additive method by hotel and days prior
fc_mul = (cum_bookings/avg_rate)) %>% ungroup() %>% #forecast using multiplicative method by hotel and days prior
### model2: simple mean additive and multiplicative model by days prior and month
group_by(hotel,days_prior,month) %>%
mutate (avg_add_m = mean(add), # average remaining bookings by hoteland days prior
avg_rate_m = mean(rate), # average monthly rate by hotel and days prior
fc_add_m = (cum_bookings + avg_add_m), # forecast using additive method by hotel, days prior and month
fc_mul_m = (cum_bookings/avg_rate_m)) %>% ungroup() %>% # forecast using multiplicative method by hotel, days prior and month
### model3: simple mean additive and multiplicative model by days prior and DOW
group_by(hotel,days_prior,DOW) %>%
mutate (avg_add_DOW = mean(add), # average remaining bookings by hotel, days prior and DOW
avg_rate_DOW = mean(rate), # average rate by hotel, days prior and DOW
fc_add_DOW = (cum_bookings + avg_add_DOW), # forecast using additive method by hotel, days prior and DOW
fc_mul_DOW = (cum_bookings/avg_rate_DOW)) %>% ungroup() %>% # forecast using multiplicative method by hotel, days prior and DOW
### model4: simple mean additive and multiplicative model by days prior , month and DOW
group_by(hotel,days_prior,month,DOW) %>%
mutate (avg_add_mDOW = mean(add), # average remaining bookings by hotel, days prior, month and DOW
avg_rate_mDOW = mean(rate), # average rate by hotel, days prior, month and DOW
fc_add_mDOW = (cum_bookings + avg_add_mDOW), # forecast using additive method by hotel, days prior, month and DOW
fc_mul_mDOW = (cum_bookings/avg_rate_mDOW)) %>% ungroup() # forecast using multiplicative method by hotel, days prior, month and DOW
### merge with the naive forecast data
naive_data <- training_dataset %>% filter(days_prior == 0) %>%
select(hotel,stay_date,final_arrivals) %>%
dplyr::rename(fc_naive= final_arrivals,naive_date = stay_date)
sta_data_add <- training_dataset %>% select(c(hotel,days_prior,avg_add)) %>% distinct()
sta_data_mul <- training_dataset %>% select(c(hotel,days_prior,avg_rate)) %>% distinct()
sta_data_add_m <- training_dataset %>% select(c(hotel,days_prior,month,avg_add_m)) %>% distinct()
sta_data_mul_m <- training_dataset %>% select(c(hotel,days_prior,month,avg_rate_m)) %>% distinct()
sta_data_add_DOW <- training_dataset %>% select(c(hotel,days_prior,DOW,avg_add_DOW)) %>% distinct()
sta_data_mul_DOW <- training_dataset %>% select(c(hotel,days_prior,DOW,avg_rate_DOW)) %>% distinct()
sta_data_add_mDOW <- training_dataset %>% select(c(hotel,days_prior,month,DOW,avg_add_mDOW)) %>% distinct()
sta_data_mul_mDOW <- training_dataset %>% select(c(hotel,days_prior,month,DOW,avg_rate_mDOW)) %>% distinct()
valid_dataset <- test_data %>%
mutate(naive_date = stay_date - 364, month = month(month)) %>% # create a naive_date column for merge
left_join(naive_data,by = c("hotel","naive_date"),copy = TRUE) %>% # find only stay date from training dateset that exist in test dataset
# add average remaining bookings by hotel and days prior to valid dataset
left_join(sta_data_add,by= c("hotel","days_prior")) %>%
# add average rate by hotel and days prior to valid dataset
left_join(sta_data_mul,by= c("hotel","days_prior")) %>%
# add average remaining bookings by hotel, days prior and month to valid dataset
left_join(sta_data_add_m,by= c("hotel","days_prior","month")) %>%
# add average rate by hotel, days prior and month to valid dataset
left_join(sta_data_mul_m,by= c("hotel","days_prior","month")) %>%
# add average remaining bookings by hotel, days prior and DOW to valid dataset
left_join(sta_data_add_DOW,by= c("hotel","days_prior","DOW")) %>%
# add average rate bookings by hotel, days prior and DOW to valid dataset
left_join(sta_data_mul_DOW,by= c("hotel","days_prior","DOW")) %>%
# add average remaining bookings by hotel, days prior, month and DOW to valid dataset
left_join(sta_data_add_mDOW,by= c("hotel","days_prior","month","DOW")) %>%
# add average rate bookings by hotel, days prior, month and DOW to valid dataset
left_join(sta_data_mul_mDOW,by= c("hotel","days_prior","month","DOW")) %>%
# forecast using additive and multiplicative method by hotel and days prior
mutate(fc_add = (cum_bookings + avg_add), fc_mul = (cum_bookings/avg_rate)) %>%
# forecast using additive and multiplicative method by hotel, days prior and month
mutate(fc_add_m = (cum_bookings + avg_add_m), fc_mul_m = (cum_bookings/avg_rate_m))%>%
# forecast using additive and multiplicative method by hotel, days prior and DOW
mutate(fc_add_DOW = (cum_bookings + avg_add_DOW), fc_mul_DOW = (cum_bookings/avg_rate_DOW)) %>%
# forecast using additive and multiplicative method by hotel, days prior, month and DOW
mutate(fc_add_mDOW = (cum_bookings + avg_add_mDOW), fc_mul_mDOW = (cum_bookings/avg_rate_mDOW))
# in-sample absolute error
fc_result_in <- training_dataset %>% filter(days_prior!=0) %>% # filter out final_day forecast
mutate(error_add= abs(final_arrivals - fc_add), # calculate absolute error for additive method daily bookings
error_mul = abs(final_arrivals - fc_mul), # calculate absolute error for muplicative method daily bookings
error_add_m = abs(final_arrivals - fc_add_m), # calculate absolute error for additive method monthly bookings
error_mul_m = abs(final_arrivals - fc_mul_m), # calculate absolute error for muplicative method monthly bookings
error_add_DOW = abs(final_arrivals - fc_add_DOW), # calculate absolute error for additive method bookings by DOW
error_mul_DOW = abs(final_arrivals - fc_mul_DOW), # calculate absolute error for muplicative method bookings by DOW
error_add_mDOW = abs(final_arrivals - fc_add_mDOW), # calculate absolute error for additive method bookings by month and DOW
error_mul_mDOW = abs(final_arrivals - fc_mul_mDOW)) # calculate absolute error for multiplicative method bookings by month and DOW
# out-sample absolute error
fc_result_out <- valid_dataset %>% filter(days_prior!=0) %>%
mutate(error_naive = abs(final_arrivals - fc_naive), # calculate absolute error produced by naive forecast
error_add = abs(final_arrivals - fc_add),# calculate absolute error for additive method daily bookings
error_mul = abs(final_arrivals - fc_mul),# calculate absolute error for muplicative method daily bookings
error_add_m = abs(final_arrivals - fc_add_m),# calculate absolute error for additive method monthly bookings
error_mul_m = abs(final_arrivals - fc_mul_m),# calculate absolute error for muplicative method monthly bookings
error_add_DOW = abs(final_arrivals - fc_add_DOW),# calculate absolute error for additive method bookings by DOW
error_mul_DOW = abs(final_arrivals - fc_mul_DOW),# calculate absolute error for muplicative method bookings by DOW
error_add_mDOW = abs(final_arrivals - fc_add_mDOW),# calculate absolute error for additive method bookings by month and DOW
error_mul_mDOW = abs(final_arrivals - fc_mul_mDOW))# calculate absolute error for multiplicative method bookings by month and DOW
###in sample
error_result_matrix <- function(train_dataset,test_dataset,hotelname, factorname) {
error_matrix_in <- train_dataset %>%
group_by_(hotelname,factorname) %>%
# MAE error measurements
summarise(MAE_add = sum(error_add)/n(),
MAE_mul = sum(error_mul)/n(),
MAE_add_m = sum(error_add_m)/n(),
MAE_mul_m = sum(error_mul_m)/n(),
MAE_add_DOW = sum(error_add_DOW)/n(),
MAE_mul_DOW = sum(error_mul_DOW)/n(),
MAE_add_mDOW = sum(error_add_mDOW)/n(),
MAE_mul_mDOW = sum(error_mul_mDOW)/n(),
# MAPE error measurements
MAPE_add = sum((error_add)/final_arrivals)/n(),
MAPE_mul = sum((error_mul)/final_arrivals)/n(),
MAPE_add_m = sum((error_add_m)/final_arrivals)/n(),
MAPE_mul_m = sum((error_mul_m)/final_arrivals)/n(),
MAPE_add_DOW = sum((error_add_DOW)/final_arrivals)/n(),
MAPE_mul_DOW = sum((error_mul_DOW)/final_arrivals)/n(),
MAPE_add_mDOW = sum((error_add_mDOW)/final_arrivals)/n(),
MAPE_mul_mDOW = sum((error_mul_mDOW)/final_arrivals)/n())
error_matrix_in[factorname] <- paste(error_matrix_in[[factorname]], "in",sep = "_")
###out sample
error_matrix_out <- test_dataset %>%
na.omit() %>% # Drop NA forecast results in test data due to lack of reference in training data
group_by_(hotelname,factorname) %>%
# MAE error measurements
summarise(MAE_naive = sum(error_naive)/n(),
MAE_add = sum(error_add)/n(),
MAE_mul = sum(error_mul)/n(),
MAE_add_m = sum(error_add_m)/n(),
MAE_mul_m = sum(error_mul_m)/n(),
MAE_add_DOW = sum(error_add_DOW)/n(),
MAE_mul_DOW = sum(error_mul_DOW)/n(),
MAE_add_mDOW = sum(error_add_mDOW)/n(),
MAE_mul_mDOW = sum(error_mul_mDOW)/n(),
# MAPE error measurements
MAPE_naive = sum((error_naive)/final_arrivals)/n(),
MAPE_add = sum((error_add)/final_arrivals)/n(),
MAPE_mul = sum((error_mul)/final_arrivals)/n(),
MAPE_add_m = sum((error_add_m)/final_arrivals)/n(),
MAPE_mul_m = sum((error_mul_m)/final_arrivals)/n(),
MAPE_add_DOW = sum((error_add_DOW)/final_arrivals)/n(),
MAPE_mul_DOW = sum((error_mul_DOW)/final_arrivals)/n(),
MAPE_add_mDOW = sum((error_add_mDOW)/final_arrivals)/n(),
MAPE_mul_mDOW = sum((error_mul_mDOW)/final_arrivals)/n(),
# MASE error measurements compared to naive model
MASE_add = sum(error_add)/sum(error_naive),
MASE_mul = sum(error_mul)/sum(error_naive),
MASE_add_m = sum(error_add_m)/sum(error_naive),
MASE_mul_m = sum(error_mul_m)/sum(error_naive),
MASE_add_DOW = sum(error_add_DOW)/sum(error_naive),
MASE_mul_DOW = sum(error_mul_DOW)/sum(error_naive),
MASE_add_mDOW = sum(error_add_mDOW)/sum(error_naive),
MASE_mul_mDOW = sum(error_mul_mDOW)/sum(error_naive))
error_matrix_out[factorname] <- paste(error_matrix_out[[factorname]], "out",sep = "_")
result<- rbind(error_matrix_in,error_matrix_out)
return(result)
}
### aggreage result by hotel and days prior category
result_daysprior <- error_result_matrix(fc_result_in,fc_result_out, "hotel","days_prior_c")
## Warning: group_by_() is deprecated.
## Please use group_by() instead
##
## The 'programming' vignette or the tidyeval book can help you
## to program with group_by() : https://tidyeval.tidyverse.org
## This warning is displayed once per session.
result_daysprior
## # A tibble: 36 x 28
## # Groups: hotel [3]
## hotel days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 GLWST 1 to 7_in 9.27 13.1 8.95 12.6 8.73
## 2 GLWST 15 to 21_in 15.4 32.4 14.8 29.9 13.9
## 3 GLWST 22 to 28_in 16.4 38.7 15.6 35.9 14.8
## 4 GLWST 29 to 60_in 17.5 53.8 16.3 48.3 15.6
## 5 GLWST 60 or more_… 17.0 109. 16.0 80.8 15.1
## 6 GLWST 8 to 14_in 14.4 26.2 13.8 24.5 13.0
## 7 MLKEP 1 to 7_in 15.5 12.6 14.4 11.7 10.4
## 8 MLKEP 15 to 21_in 34.8 40.0 33.3 35.8 20.8
## 9 MLKEP 22 to 28_in 36.8 48.6 35.3 43.5 22.0
## 10 MLKEP 29 to 60_in 38.7 67.8 37.4 60.9 23.8
## # … with 26 more rows, and 21 more variables: MAE_mul_DOW <dbl>,
## # MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>, MAPE_add <dbl>,
## # MAPE_mul <dbl>, MAPE_add_m <dbl>, MAPE_mul_m <dbl>,
## # MAPE_add_DOW <dbl>, MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## # MAPE_mul_mDOW <dbl>, MAE_naive <dbl>, MAPE_naive <dbl>,
## # MASE_add <dbl>, MASE_mul <dbl>, MASE_add_m <dbl>, MASE_mul_m <dbl>,
## # MASE_add_DOW <dbl>, MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## # MASE_mul_mDOW <dbl>
### aggreage result by hotel and month
result_month <- error_result_matrix(fc_result_in,fc_result_out, "hotel", "month")
result_month
## # A tibble: 54 x 28
## # Groups: hotel [3]
## hotel month MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 GLWST 1_in 25.7 40.2 19.7 34.6 23.8 39.6
## 2 GLWST 2_in 15.8 65.4 14.9 61.2 14.0 61.9
## 3 GLWST 3_in 15.7 64.9 11.2 54.1 13.9 61.4
## 4 GLWST 4_in 15.3 55.0 13.4 38.8 14.2 51.3
## 5 GLWST 5_in 16.5 61.0 16.4 61.8 15.2 59.4
## 6 GLWST 6_in 17.4 125. 17.2 87.5 15.4 115.
## 7 GLWST 7_in 13.9 81.8 13.1 80.2 12.1 73.9
## 8 GLWST 8_in 17.2 185. 17.4 90.6 16.3 192.
## 9 GLWST 9_in 18.0 57.0 17.5 54.6 14.5 56.6
## 10 GLWST 10_in 15.8 61.3 14.7 63.2 13.1 57.9
## # … with 44 more rows, and 20 more variables: MAE_add_mDOW <dbl>,
## # MAE_mul_mDOW <dbl>, MAPE_add <dbl>, MAPE_mul <dbl>, MAPE_add_m <dbl>,
## # MAPE_mul_m <dbl>, MAPE_add_DOW <dbl>, MAPE_mul_DOW <dbl>,
## # MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>, MAE_naive <dbl>,
## # MAPE_naive <dbl>, MASE_add <dbl>, MASE_mul <dbl>, MASE_add_m <dbl>,
## # MASE_mul_m <dbl>, MASE_add_DOW <dbl>, MASE_mul_DOW <dbl>,
## # MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
### aggreage result by hotel and DOW
result_DOW <- error_result_matrix(fc_result_in,fc_result_out,"hotel", "DOW")
result_DOW
## # A tibble: 42 x 28
## # Groups: hotel [3]
## hotel DOW MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 GLWST Sun_… 21.5 89.0 21.3 64.8 17.5 74.2
## 2 GLWST Mon_… 17.8 102. 16.8 71.8 17.4 93.4
## 3 GLWST Tue_… 17.6 97.7 16.1 68.1 15.7 99.9
## 4 GLWST Wed_… 16.3 87.1 15.1 64.5 14.0 91.6
## 5 GLWST Thu_… 14.2 70.0 13.2 48.3 14.0 74.1
## 6 GLWST Fri_… 13.8 77.6 12.5 63.6 13.8 76.2
## 7 GLWST Sat_… 15.8 96.5 15.0 90.5 11.6 92.3
## 8 MLKEP Sun_… 45.1 29.9 43.9 26.9 14.1 24.4
## 9 MLKEP Mon_… 31.0 64.3 26.9 57.1 27.7 66.0
## 10 MLKEP Tue_… 46.8 77.1 43.2 71.7 26.4 62.1
## # … with 32 more rows, and 20 more variables: MAE_add_mDOW <dbl>,
## # MAE_mul_mDOW <dbl>, MAPE_add <dbl>, MAPE_mul <dbl>, MAPE_add_m <dbl>,
## # MAPE_mul_m <dbl>, MAPE_add_DOW <dbl>, MAPE_mul_DOW <dbl>,
## # MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>, MAE_naive <dbl>,
## # MAPE_naive <dbl>, MASE_add <dbl>, MASE_mul <dbl>, MASE_add_m <dbl>,
## # MASE_mul_m <dbl>, MASE_add_DOW <dbl>, MASE_mul_DOW <dbl>,
## # MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
result_DOW_G <- result_DOW %>% filter(hotel == "GLWST") %>% arrange(DOW)
result_DOW_G_MAE <- result_DOW_G[names(result_DOW_G) %like% "MAE" | names(result_DOW_G) == "DOW"]
result_DOW_G_MAE
## # A tibble: 14 x 10
## DOW MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… 13.8 77.6 12.5 63.6 13.8 76.2
## 2 Fri_… 14.7 43.3 14.1 73.8 14.5 40.4
## 3 Mon_… 17.8 102. 16.8 71.8 17.4 93.4
## 4 Mon_… 18.2 54.5 16.2 43.7 17.0 52.5
## 5 Sat_… 15.8 96.5 15.0 90.5 11.6 92.3
## 6 Sat_… 17.1 54.9 16.8 90.0 14.9 49.9
## 7 Sun_… 21.5 89.0 21.3 64.8 17.5 74.2
## 8 Sun_… 26.8 37.9 23.6 38.3 17.3 40.6
## 9 Thu_… 14.2 70.0 13.2 48.3 14.0 74.1
## 10 Thu_… 22.8 41.8 20.3 42.2 21.9 40.1
## 11 Tue_… 17.6 97.7 16.1 68.1 15.7 99.9
## 12 Tue_… 21.9 52.5 17.7 44.0 22.7 51.5
## 13 Wed_… 16.3 87.1 15.1 64.5 14.0 91.6
## 14 Wed_… 21.2 61.8 16.9 49.6 20.9 58.6
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_DOW_G_MAPE <- result_DOW_G[names(result_DOW_G) %like% "MAPE" | names(result_DOW_G) == "DOW"]
result_DOW_G_MAPE
## # A tibble: 14 x 10
## DOW MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… 0.144 0.672 0.126 0.565 0.142 0.659
## 2 Fri_… 0.293 0.426 0.250 0.752 0.288 0.397
## 3 Mon_… 0.199 0.898 0.187 0.644 0.192 0.830
## 4 Mon_… 0.249 0.625 0.211 0.506 0.233 0.599
## 5 Sat_… 0.137 0.775 0.126 0.724 0.106 0.743
## 6 Sat_… 0.265 0.491 0.240 0.822 0.264 0.446
## 7 Sun_… 0.307 0.844 0.303 0.635 0.223 0.724
## 8 Sun_… 0.405 0.484 0.354 0.518 0.244 0.516
## 9 Thu_… 0.167 0.621 0.150 0.451 0.162 0.647
## 10 Thu_… 0.458 0.497 0.382 0.521 0.439 0.483
## 11 Tue_… 0.181 0.805 0.160 0.574 0.172 0.819
## 12 Tue_… 0.313 0.581 0.239 0.509 0.343 0.567
## 13 Wed_… 0.171 0.709 0.153 0.534 0.161 0.737
## 14 Wed_… 0.300 0.607 0.224 0.512 0.321 0.570
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## # MAPE_naive <dbl>
result_DOW_G_MASE <- result_DOW_G[names(result_DOW_G) %like% "MASE" | names(result_DOW_G) == "DOW"]
result_DOW_G_MASE
## # A tibble: 14 x 9
## DOW MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… NA NA NA NA NA NA
## 2 Fri_… 0.894 2.64 0.862 4.50 0.882 2.46
## 3 Mon_… NA NA NA NA NA NA
## 4 Mon_… 0.978 2.94 0.871 2.36 0.918 2.83
## 5 Sat_… NA NA NA NA NA NA
## 6 Sat_… 1.20 3.84 1.17 6.29 1.04 3.49
## 7 Sun_… NA NA NA NA NA NA
## 8 Sun_… 1.24 1.76 1.09 1.78 0.804 1.89
## 9 Thu_… NA NA NA NA NA NA
## 10 Thu_… 1.12 2.06 1.00 2.08 1.08 1.98
## 11 Tue_… NA NA NA NA NA NA
## 12 Tue_… 1.10 2.63 0.884 2.20 1.14 2.58
## 13 Wed_… NA NA NA NA NA NA
## 14 Wed_… 0.899 2.62 0.715 2.10 0.885 2.48
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
#Monthly
result_month_G <- result_month %>% filter(hotel == "GLWST") %>% arrange(month)
result_month_G_MAE <- result_month_G[names(result_month_G) %like% "MAE" | names(result_month_G) == "month"]
result_month_G_MAE
## # A tibble: 18 x 10
## month MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1_in 25.7 40.2 19.7 34.6 23.8 39.6
## 2 1_out 30.4 31.0 19.5 47.4 29.5 29.0
## 3 10_in 15.8 61.3 14.7 63.2 13.1 57.9
## 4 11_in 14.0 51.6 13.5 55.9 11.7 49.2
## 5 11_o… 17.2 58.9 17.2 58.9 12.6 55.9
## 6 12_in 18.6 50.0 15.7 46.5 17.8 47.7
## 7 12_o… 26.5 41.7 23.0 37.0 25.2 39.1
## 8 2_in 15.8 65.4 14.9 61.2 14.0 61.9
## 9 2_out 17.1 50.0 18.2 78.8 14.8 48.2
## 10 3_in 15.7 64.9 11.2 54.1 13.9 61.4
## 11 3_out 14.4 53.8 13.4 65.3 12.2 54.7
## 12 4_in 15.3 55.0 13.4 38.8 14.2 51.3
## 13 4_out 15.0 57.8 14.8 62.2 14.3 55.2
## 14 5_in 16.5 61.0 16.4 61.8 15.2 59.4
## 15 6_in 17.4 125. 17.2 87.5 15.4 115.
## 16 7_in 13.9 81.8 13.1 80.2 12.1 73.9
## 17 8_in 17.2 185. 17.4 90.6 16.3 192.
## 18 9_in 18.0 57.0 17.5 54.6 14.5 56.6
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_month_G_MAPE <- result_month_G[names(result_month_G) %like% "MAPE" | names(result_month_G) == "month"]
result_month_G_MAPE
## # A tibble: 18 x 10
## month MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1_in 0.489 0.504 0.321 0.426 0.466 0.500
## 2 1_out 0.622 0.438 0.375 0.729 0.610 0.413
## 3 10_in 0.162 0.549 0.158 0.548 0.130 0.523
## 4 11_in 0.148 0.471 0.145 0.518 0.120 0.453
## 5 11_o… 0.191 0.566 0.194 0.556 0.135 0.542
## 6 12_in 0.368 0.522 0.283 0.487 0.371 0.507
## 7 12_o… 0.573 0.486 0.463 0.455 0.564 0.459
## 8 2_in 0.172 0.639 0.169 0.565 0.148 0.605
## 9 2_out 0.210 0.550 0.231 0.823 0.182 0.526
## 10 3_in 0.154 0.564 0.124 0.481 0.131 0.537
## 11 3_out 0.155 0.515 0.157 0.618 0.131 0.521
## 12 4_in 0.148 0.495 0.138 0.347 0.140 0.462
## 13 4_out 0.164 0.576 0.173 0.596 0.151 0.554
## 14 5_in 0.203 0.583 0.196 0.566 0.181 0.567
## 15 6_in 0.168 1.07 0.166 0.763 0.149 0.966
## 16 7_in 0.125 0.690 0.121 0.679 0.108 0.624
## 17 8_in 0.157 1.44 0.157 0.723 0.145 1.49
## 18 9_in 0.190 0.508 0.190 0.476 0.150 0.504
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## # MAPE_naive <dbl>
result_month_G_MASE <- result_month_G[names(result_month_G) %like% "MASE" | names(result_month_G) == "month"]
result_month_G_MASE
## # A tibble: 18 x 9
## month MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1_in NA NA NA NA NA NA
## 2 1_out 1.86 1.89 1.19 2.90 1.80 1.77
## 3 10_in NA NA NA NA NA NA
## 4 11_in NA NA NA NA NA NA
## 5 11_o… 1.06 3.61 1.06 3.61 0.770 3.43
## 6 12_in NA NA NA NA NA NA
## 7 12_o… 1.26 1.98 1.09 1.76 1.19 1.85
## 8 2_in NA NA NA NA NA NA
## 9 2_out 1.43 4.18 1.52 6.59 1.23 4.03
## 10 3_in NA NA NA NA NA NA
## 11 3_out 0.615 2.29 0.573 2.78 0.519 2.33
## 12 4_in NA NA NA NA NA NA
## 13 4_out 0.670 2.59 0.663 2.78 0.639 2.47
## 14 5_in NA NA NA NA NA NA
## 15 6_in NA NA NA NA NA NA
## 16 7_in NA NA NA NA NA NA
## 17 8_in NA NA NA NA NA NA
## 18 9_in NA NA NA NA NA NA
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
#Days prior categories
result_daysprior_G <- result_daysprior %>% filter(hotel == "GLWST") %>% arrange(days_prior_c)
result_daysprior_G_MAE <- result_daysprior_G[names(result_daysprior_G) %like% "MAE" | names(result_daysprior_G) == "days_prior_c"]
result_daysprior_G_MAE
## # A tibble: 12 x 10
## days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in 9.27 13.1 8.95 12.6 8.73 12.1
## 2 1 to 7_out 9.20 13.1 8.81 13.3 8.60 11.6
## 3 15 to 21_in 15.4 32.4 14.8 29.9 13.9 29.3
## 4 15 to 21_out 16.6 35.4 15.0 34.8 15.3 31.5
## 5 22 to 28_in 16.4 38.7 15.6 35.9 14.8 36.1
## 6 22 to 28_out 17.6 39.6 15.3 40.6 16.3 34.8
## 7 29 to 60_in 17.5 53.8 16.3 48.3 15.6 51.0
## 8 29 to 60_out 20.0 45.0 16.9 45.6 18.5 41.6
## 9 60 or more_… 17.0 109. 16.0 80.8 15.1 107.
## 10 60 or more_… 21.9 56.6 19.7 68.4 19.3 55.5
## 11 8 to 14_in 14.4 26.2 13.8 24.5 13.0 23.1
## 12 8 to 14_out 15.0 27.6 13.6 26.9 13.8 24.2
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_daysprior_G_MAPE <- result_daysprior_G[names(result_daysprior_G) %like% "MAPE" | names(result_daysprior_G) == "days_prior_c"]
result_daysprior_G_MAPE
## # A tibble: 12 x 10
## days_prior_c MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in 0.101 0.123 0.0954 0.120 0.0957
## 2 1 to 7_out 0.122 0.154 0.113 0.155 0.115
## 3 15 to 21_in 0.180 0.302 0.167 0.280 0.164
## 4 15 to 21_out 0.241 0.408 0.200 0.398 0.226
## 5 22 to 28_in 0.194 0.360 0.178 0.332 0.177
## 6 22 to 28_out 0.269 0.450 0.213 0.454 0.252
## 7 29 to 60_in 0.214 0.489 0.191 0.442 0.191
## 8 29 to 60_out 0.326 0.503 0.253 0.506 0.304
## 9 60 or more_… 0.184 0.926 0.171 0.698 0.162
## 10 60 or more_… 0.359 0.584 0.308 0.722 0.332
## 11 8 to 14_in 0.162 0.243 0.152 0.229 0.149
## 12 8 to 14_out 0.206 0.321 0.174 0.312 0.193
## # … with 4 more variables: MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## # MAPE_mul_mDOW <dbl>, MAPE_naive <dbl>
result_daysprior_G_MASE <- result_daysprior_G[names(result_daysprior_G) %like% "MASE" | names(result_daysprior_G) == "days_prior_c"]
result_daysprior_G_MASE
## # A tibble: 12 x 9
## days_prior_c MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in NA NA NA NA NA
## 2 1 to 7_out 0.470 0.670 0.450 0.677 0.439
## 3 15 to 21_in NA NA NA NA NA
## 4 15 to 21_out 0.847 1.81 0.767 1.78 0.784
## 5 22 to 28_in NA NA NA NA NA
## 6 22 to 28_out 0.895 2.02 0.780 2.07 0.832
## 7 29 to 60_in NA NA NA NA NA
## 8 29 to 60_out 1.03 2.32 0.868 2.35 0.952
## 9 60 or more_… NA NA NA NA NA
## 10 60 or more_… 1.18 3.04 1.06 3.67 1.04
## 11 8 to 14_in NA NA NA NA NA
## 12 8 to 14_out 0.764 1.41 0.694 1.37 0.704
## # … with 3 more variables: MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## # MASE_mul_mDOW <dbl>
#DOW
result_DOW_M <- result_DOW %>% filter(hotel == "MLKEP") %>% arrange(DOW)
result_DOW_M_MAE <- result_DOW_M[names(result_DOW_M) %like% "MAE" | names(result_DOW_M) == "DOW"]
result_DOW_M_MAE
## # A tibble: 14 x 10
## DOW MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… 38.9 56.3 36.6 45.2 19.7 37.5
## 2 Fri_… 40.9 28.5 45.6 52.6 11.6 24.2
## 3 Mon_… 31.0 64.3 26.9 57.1 27.7 66.0
## 4 Mon_… 34.1 62.3 28.8 51.7 27.5 52.5
## 5 Sat_… 27.7 83.7 26.1 69.3 26.1 63.4
## 6 Sat_… 27.3 49.5 28.3 75.7 23.6 42.3
## 7 Sun_… 45.1 29.9 43.9 26.9 14.1 24.4
## 8 Sun_… 44.0 17.6 46.6 17.1 8.67 18.6
## 9 Thu_… 24.9 52.8 21.9 46.0 24.5 54.8
## 10 Thu_… 24.4 59.6 22.1 58.8 25.3 60.3
## 11 Tue_… 46.8 77.1 43.2 71.7 26.4 62.1
## 12 Tue_… 59.2 82.9 53.9 72.2 34.3 61.2
## 13 Wed_… 41.6 83.7 39.0 73.1 25.9 85.9
## 14 Wed_… 57.9 83.5 54.2 82.9 34.6 75.4
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_DOW_M_MAPE <- result_DOW_M[names(result_DOW_M) %like% "MAPE" | names(result_DOW_M) == "DOW"]
result_DOW_M_MAPE
## # A tibble: 14 x 10
## DOW MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… 0.896 0.807 0.832 0.680 0.367 0.554
## 2 Fri_… 0.985 0.542 1.10 1.00 0.298 0.482
## 3 Mon_… 0.357 0.554 0.304 0.504 0.374 0.577
## 4 Mon_… 0.351 0.545 0.307 0.452 0.336 0.499
## 5 Sat_… 0.384 0.787 0.350 0.658 0.345 0.607
## 6 Sat_… 0.533 0.590 0.510 0.846 0.450 0.514
## 7 Sun_… 1.47 0.608 1.39 0.563 0.396 0.508
## 8 Sun_… 1.22 0.406 1.27 0.419 0.230 0.431
## 9 Thu_… 0.454 0.572 0.345 0.507 0.432 0.595
## 10 Thu_… 0.399 0.641 0.357 0.619 0.391 0.659
## 11 Tue_… 0.387 0.572 0.354 0.526 0.332 0.529
## 12 Tue_… 0.476 0.539 0.434 0.471 0.415 0.449
## 13 Wed_… 0.315 0.636 0.298 0.549 0.259 0.687
## 14 Wed_… 0.567 0.654 0.530 0.641 0.540 0.693
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## # MAPE_naive <dbl>
result_DOW_M_MASE <- result_DOW_M[names(result_DOW_M) %like% "MASE" | names(result_DOW_M) == "DOW"]
result_DOW_M_MASE
## # A tibble: 14 x 9
## DOW MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… NA NA NA NA NA NA
## 2 Fri_… 3.75 2.62 4.19 4.82 1.07 2.22
## 3 Mon_… NA NA NA NA NA NA
## 4 Mon_… 1.32 2.41 1.12 2.00 1.07 2.04
## 5 Sat_… NA NA NA NA NA NA
## 6 Sat_… 1.46 2.64 1.51 4.04 1.26 2.26
## 7 Sun_… NA NA NA NA NA NA
## 8 Sun_… 3.60 1.44 3.81 1.40 0.709 1.52
## 9 Thu_… NA NA NA NA NA NA
## 10 Thu_… 0.837 2.05 0.760 2.02 0.869 2.07
## 11 Tue_… NA NA NA NA NA NA
## 12 Tue_… 3.30 4.62 3.00 4.02 1.91 3.41
## 13 Wed_… NA NA NA NA NA NA
## 14 Wed_… 2.83 4.08 2.65 4.05 1.69 3.68
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
#Monthly
result_month_M <- result_month %>% filter(hotel == "MLKEP") %>% arrange(month)
result_month_M_MAE <- result_month_M[names(result_month_M) %like% "MAE" | names(result_month_M) == "month"]
result_month_M_MAE
## # A tibble: 18 x 10
## month MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1_in 44.1 38.6 36.4 34.9 25.8 35.0
## 2 1_out 45.0 42.8 41.1 38.4 29.0 35.7
## 3 10_in 38.7 46.8 38.4 41.2 19.8 38.9
## 4 11_in 39.6 49.8 38.3 44.7 20.0 40.2
## 5 11_o… 42.3 64.9 40.9 51.6 23.5 59.1
## 6 12_in 49.7 56.0 46.4 51.7 39.6 56.8
## 7 12_o… 47.1 56.2 46.0 52.5 36.3 53.4
## 8 2_in 35.5 51.8 33.0 55.7 16.6 51.5
## 9 2_out 34.1 48.9 34.5 38.4 12.5 42.3
## 10 3_in 35.4 61.3 33.9 47.7 16.6 54.6
## 11 3_out 38.1 64.0 37.0 109. 19.7 54.0
## 12 4_in 38.6 55.6 37.4 56.0 19.3 50.8
## 13 4_out 38.4 45.4 39.0 47.3 19.9 35.4
## 14 5_in 36.2 68.1 31.0 53.4 27.9 53.5
## 15 6_in 37.8 100. 33.7 74.0 31.6 94.0
## 16 7_in 38.1 94.0 36.7 79.9 28.3 84.2
## 17 8_in 22.9 42.7 21.8 43.4 13.8 33.6
## 18 9_in 33.8 57.3 31.3 56.5 18.8 45.5
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_month_M_MAPE <- result_month_M[names(result_month_M) %like% "MAPE" | names(result_month_M) == "month"]
result_month_M_MAPE
## # A tibble: 18 x 10
## month MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1_in 1.46 0.506 0.938 0.509 1.02 0.537
## 2 1_out 0.983 0.459 0.819 0.473 0.583 0.413
## 3 10_in 0.544 0.454 0.554 0.447 0.238 0.415
## 4 11_in 0.502 0.430 0.546 0.431 0.208 0.390
## 5 11_o… 0.463 0.556 0.500 0.434 0.203 0.540
## 6 12_in 1.14 0.721 0.972 0.621 0.925 0.886
## 7 12_o… 0.954 0.754 0.881 0.675 0.872 0.831
## 8 2_in 0.557 0.531 0.535 0.586 0.223 0.539
## 9 2_out 0.479 0.490 0.525 0.392 0.156 0.468
## 10 3_in 0.415 0.535 0.463 0.441 0.162 0.498
## 11 3_out 0.486 0.570 0.553 1.16 0.215 0.485
## 12 4_in 0.628 0.562 0.613 0.558 0.295 0.501
## 13 4_out 0.561 0.474 0.574 0.528 0.272 0.390
## 14 5_in 0.751 0.747 0.558 0.586 0.508 0.572
## 15 6_in 0.573 0.860 0.538 0.626 0.404 0.799
## 16 7_in 0.514 1.04 0.543 0.821 0.328 0.858
## 17 8_in 0.390 0.486 0.328 0.510 0.190 0.399
## 18 9_in 0.375 0.504 0.396 0.524 0.181 0.404
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## # MAPE_naive <dbl>
result_month_M_MASE <- result_month_M[names(result_month_M) %like% "MASE" | names(result_month_M) == "month"]
result_month_M_MASE
## # A tibble: 18 x 9
## month MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1_in NA NA NA NA NA NA
## 2 1_out 2.80 2.67 2.56 2.39 1.81 2.22
## 3 10_in NA NA NA NA NA NA
## 4 11_in NA NA NA NA NA NA
## 5 11_o… 1.96 3.01 1.89 2.39 1.09 2.74
## 6 12_in NA NA NA NA NA NA
## 7 12_o… 2.19 2.62 2.14 2.44 1.69 2.49
## 8 2_in NA NA NA NA NA NA
## 9 2_out 2.33 3.33 2.35 2.62 0.849 2.89
## 10 3_in NA NA NA NA NA NA
## 11 3_out 2.13 3.58 2.07 6.08 1.10 3.02
## 12 4_in NA NA NA NA NA NA
## 13 4_out 1.77 2.10 1.80 2.18 0.918 1.63
## 14 5_in NA NA NA NA NA NA
## 15 6_in NA NA NA NA NA NA
## 16 7_in NA NA NA NA NA NA
## 17 8_in NA NA NA NA NA NA
## 18 9_in NA NA NA NA NA NA
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
#Days prior categories
result_daysprior_M <- result_daysprior %>% filter(hotel == "MLKEP") %>% arrange(days_prior_c)
result_daysprior_M_MAE <- result_daysprior_M[names(result_daysprior_M) %like% "MAE" | names(result_daysprior_M) == "days_prior_c"]
result_daysprior_M_MAE
## # A tibble: 12 x 10
## days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in 15.5 12.6 14.4 11.7 10.4 11.6
## 2 1 to 7_out 17.5 13.2 17.5 13.1 11.0 12.0
## 3 15 to 21_in 34.8 40.0 33.3 35.8 20.8 33.1
## 4 15 to 21_out 39.9 41.8 39.2 44.0 21.7 33.8
## 5 22 to 28_in 36.8 48.6 35.3 43.5 22.0 40.4
## 6 22 to 28_out 42.3 52.8 41.5 56.1 22.8 43.5
## 7 29 to 60_in 38.7 67.8 37.4 60.9 23.8 56.2
## 8 29 to 60_out 44.0 66.0 43.5 71.2 24.3 56.5
## 9 60 or more_… 38.3 80.7 34.4 68.3 26.5 72.5
## 10 60 or more_… 44.8 64.2 42.9 73.0 28.1 58.3
## 11 8 to 14_in 30.7 29.3 29.0 25.9 18.7 24.7
## 12 8 to 14_out 34.3 28.5 33.8 28.9 18.7 23.8
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_daysprior_M_MAPE <- result_daysprior_M[names(result_daysprior_M) %like% "MAPE" | names(result_daysprior_M) == "days_prior_c"]
result_daysprior_M_MAPE
## # A tibble: 12 x 10
## days_prior_c MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in 0.258 0.142 0.237 0.129 0.155
## 2 1 to 7_out 0.254 0.137 0.263 0.135 0.150
## 3 15 to 21_in 0.598 0.433 0.565 0.391 0.321
## 4 15 to 21_out 0.608 0.421 0.612 0.445 0.325
## 5 22 to 28_in 0.635 0.522 0.602 0.479 0.341
## 6 22 to 28_out 0.629 0.533 0.635 0.561 0.337
## 7 29 to 60_in 0.646 0.714 0.622 0.651 0.360
## 8 29 to 60_out 0.670 0.676 0.684 0.736 0.375
## 9 60 or more_… 0.607 0.784 0.526 0.667 0.395
## 10 60 or more_… 0.749 0.660 0.716 0.854 0.503
## 11 8 to 14_in 0.519 0.319 0.486 0.283 0.283
## 12 8 to 14_out 0.525 0.291 0.532 0.299 0.281
## # … with 4 more variables: MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## # MAPE_mul_mDOW <dbl>, MAPE_naive <dbl>
result_daysprior_M_MASE <- result_daysprior_M[names(result_daysprior_M) %like% "MASE" | names(result_daysprior_M) == "days_prior_c"]
result_daysprior_M_MASE
## # A tibble: 12 x 9
## days_prior_c MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in NA NA NA NA NA
## 2 1 to 7_out 0.934 0.701 0.931 0.695 0.585
## 3 15 to 21_in NA NA NA NA NA
## 4 15 to 21_out 2.13 2.22 2.09 2.34 1.15
## 5 22 to 28_in NA NA NA NA NA
## 6 22 to 28_out 2.25 2.82 2.22 3.00 1.22
## 7 29 to 60_in NA NA NA NA NA
## 8 29 to 60_out 2.32 3.48 2.29 3.75 1.28
## 9 60 or more_… NA NA NA NA NA
## 10 60 or more_… 2.26 3.24 2.17 3.69 1.42
## 11 8 to 14_in NA NA NA NA NA
## 12 8 to 14_out 1.83 1.52 1.80 1.54 0.995
## # … with 3 more variables: MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## # MASE_mul_mDOW <dbl>
#DOW
result_DOW_W <- result_DOW %>% filter(hotel == "WARUK") %>% arrange(DOW)
result_DOW_W_MAE <- result_DOW_W[names(result_DOW_W) %like% "MAE" | names(result_DOW_W) == "DOW"]
result_DOW_W_MAE
## # A tibble: 14 x 10
## DOW MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… 25.3 49.5 23.1 46.1 20.3 35.9
## 2 Fri_… 38.2 21.2 29.7 22.9 24.7 17.7
## 3 Mon_… 20.0 38.9 20.4 35.2 19.6 37.0
## 4 Mon_… 17.0 34.1 15.7 29.7 18.2 27.9
## 5 Sat_… 26.6 77.2 23.5 73.8 22.2 58.5
## 6 Sat_… 26.7 30.2 20.1 32.6 33.6 28.4
## 7 Sun_… 42.7 22.1 42.5 20.6 11.4 17.9
## 8 Sun_… 51.1 12.1 42.7 15.5 12.2 10.3
## 9 Thu_… 20.8 37.5 18.0 31.9 19.6 37.4
## 10 Thu_… 23.9 28.5 20.5 25.1 19.9 27.6
## 11 Tue_… 29.4 61.4 29.1 55.8 18.0 57.1
## 12 Tue_… 29.3 61.3 32.2 54.4 22.5 46.9
## 13 Wed_… 24.2 57.4 23.5 50.9 17.0 53.1
## 14 Wed_… 21.9 48.2 24.6 43.8 23.7 41.0
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_DOW_W_MAPE <- result_DOW_W[names(result_DOW_W) %like% "MAPE" | names(result_DOW_W) == "DOW"]
result_DOW_W_MAPE
## # A tibble: 14 x 10
## DOW MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… 0.468 0.635 0.424 0.602 0.327 0.470
## 2 Fri_… 1.36 0.570 1.07 0.670 0.902 0.461
## 3 Mon_… 0.279 0.456 0.280 0.412 0.280 0.442
## 4 Mon_… 0.395 0.474 0.344 0.437 0.434 0.412
## 5 Sat_… 0.298 0.696 0.255 0.678 0.291 0.527
## 6 Sat_… 0.691 0.574 0.490 0.590 0.834 0.527
## 7 Sun_… 1.46 0.543 1.42 0.520 0.349 0.417
## 8 Sun_… 2.48 0.519 2.06 0.656 0.659 0.428
## 9 Thu_… 0.358 0.523 0.303 0.445 0.311 0.522
## 10 Thu_… 0.592 0.514 0.482 0.423 0.494 0.510
## 11 Tue_… 0.281 0.566 0.270 0.503 0.225 0.544
## 12 Tue_… 0.351 0.580 0.347 0.518 0.387 0.461
## 13 Wed_… 0.228 0.553 0.217 0.484 0.192 0.523
## 14 Wed_… 0.491 0.584 0.442 0.502 0.642 0.579
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## # MAPE_naive <dbl>
result_DOW_W_MASE <- result_DOW_W[names(result_DOW_W) %like% "MASE" | names(result_DOW_W) == "DOW"]
result_DOW_W_MASE
## # A tibble: 14 x 9
## DOW MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fri_… NA NA NA NA NA NA
## 2 Fri_… 1.75 0.974 1.36 1.05 1.14 0.815
## 3 Mon_… NA NA NA NA NA NA
## 4 Mon_… 0.742 1.49 0.686 1.30 0.796 1.22
## 5 Sat_… NA NA NA NA NA NA
## 6 Sat_… 0.994 1.13 0.749 1.21 1.25 1.06
## 7 Sun_… NA NA NA NA NA NA
## 8 Sun_… 5.79 1.37 4.84 1.76 1.38 1.17
## 9 Thu_… NA NA NA NA NA NA
## 10 Thu_… 1.13 1.35 0.970 1.19 0.940 1.31
## 11 Tue_… NA NA NA NA NA NA
## 12 Tue_… 1.19 2.50 1.31 2.22 0.918 1.91
## 13 Wed_… NA NA NA NA NA NA
## 14 Wed_… 0.842 1.85 0.948 1.69 0.914 1.58
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>
#Monthly
result_month_W <- result_month %>% filter(hotel == "WARUK") %>% arrange(month)
result_month_W_MAE <- result_month_W[names(result_month_W) %like% "MAE" | names(result_month_W) == "month"]
result_month_W_MAPE <- result_month_W[names(result_month_W) %like% "MAPE" | names(result_month_W) == "month"]
result_month_W_MASE <- result_month_W[names(result_month_W) %like% "MASE" | names(result_month_W) == "month"]
#Days prior categories
result_daysprior_W <- result_daysprior %>% filter(hotel == "WARUK") %>% arrange(days_prior_c)
result_daysprior_W_MAE <- result_daysprior_W[names(result_daysprior_W) %like% "MAE" | names(result_daysprior_W) == "days_prior_c"]
result_daysprior_W_MAE
## # A tibble: 12 x 10
## days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in 13.1 14.4 12.7 13.7 9.44 12.8
## 2 1 to 7_out 13.8 11.2 13.0 10.7 9.27 9.82
## 3 15 to 21_in 25.1 38.9 24.2 35.7 16.4 29.9
## 4 15 to 21_out 27.8 29.1 25.7 28.6 19.4 21.9
## 5 22 to 28_in 26.4 43.8 25.4 41.0 17.6 31.3
## 6 22 to 28_out 29.2 32.0 26.6 32.3 20.9 23.6
## 7 29 to 60_in 27.6 52.8 26.5 48.4 18.9 39.0
## 8 29 to 60_out 31.1 34.7 27.7 32.8 23.4 29.2
## 9 60 or more_… 28.3 53.2 26.8 48.5 19.2 48.4
## 10 60 or more_… 30.5 41.5 27.6 38.6 24.4 36.0
## 11 8 to 14_in 22.5 30.4 21.9 28.3 14.7 24.8
## 12 8 to 14_out 24.6 24.8 23.1 23.4 15.8 19.0
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## # MAE_naive <dbl>
result_daysprior_W_MAPE <- result_daysprior_W[names(result_daysprior_W) %like% "MAPE" | names(result_daysprior_W) == "days_prior_c"]
result_daysprior_W_MAPE
## # A tibble: 12 x 10
## days_prior_c MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in 0.250 0.173 0.239 0.167 0.159
## 2 1 to 7_out 0.410 0.199 0.356 0.193 0.271
## 3 15 to 21_in 0.482 0.467 0.457 0.433 0.274
## 4 15 to 21_out 0.899 0.486 0.767 0.500 0.614
## 5 22 to 28_in 0.506 0.529 0.478 0.495 0.294
## 6 22 to 28_out 0.936 0.548 0.793 0.578 0.632
## 7 29 to 60_in 0.517 0.623 0.488 0.577 0.311
## 8 29 to 60_out 1.00 0.573 0.833 0.561 0.704
## 9 60 or more_… 0.486 0.603 0.454 0.550 0.283
## 10 60 or more_… 0.820 0.601 0.667 0.585 0.602
## 11 8 to 14_in 0.441 0.363 0.422 0.343 0.256
## 12 8 to 14_out 0.758 0.410 0.654 0.400 0.494
## # … with 4 more variables: MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## # MAPE_mul_mDOW <dbl>, MAPE_naive <dbl>
result_daysprior_W_MASE <- result_daysprior_W[names(result_daysprior_W) %like% "MASE" | names(result_daysprior_W) == "days_prior_c"]
result_daysprior_W_MASE
## # A tibble: 12 x 9
## days_prior_c MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 to 7_in NA NA NA NA NA
## 2 1 to 7_out 0.623 0.506 0.584 0.481 0.418
## 3 15 to 21_in NA NA NA NA NA
## 4 15 to 21_out 1.25 1.31 1.16 1.29 0.874
## 5 22 to 28_in NA NA NA NA NA
## 6 22 to 28_out 1.31 1.44 1.19 1.45 0.937
## 7 29 to 60_in NA NA NA NA NA
## 8 29 to 60_out 1.38 1.54 1.23 1.46 1.04
## 9 60 or more_… NA NA NA NA NA
## 10 60 or more_… 1.41 1.92 1.28 1.78 1.13
## 11 8 to 14_in NA NA NA NA NA
## 12 8 to 14_out 1.11 1.12 1.04 1.05 0.713
## # … with 3 more variables: MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## # MASE_mul_mDOW <dbl>
# manipulate data by sample, days prior group, model, and error
result_DOW_G_MAE_g <- gather(result_DOW_G_MAE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
result_DOW_G_MAPE_g <- gather(result_DOW_G_MAPE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
result_DOW_G_MASE_g <- gather(result_DOW_G_MASE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
# plot MAE errors for in and out samples by days prior across all 8 models
g1 <- result_DOW_G_MAE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MAE by Day of Week ") +
xlab("DOW") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 7 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by days prior across all 8 models
g2 <- result_DOW_G_MAPE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MAPE by Day of Week ") +
xlab("DOW") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 7 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by days prior across all 8 models
g3 <- result_DOW_G_MASE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MASE by Day of Week ") +
xlab("DOW") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 56 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_month_G_MAE_g <- gather(result_month_G_MAE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
result_month_G_MAPE_g <- gather(result_month_G_MAPE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
result_month_G_MASE_g <- gather(result_month_G_MASE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
# plot MAE errors for in and out samples by month across all 8 models
g1 <- result_month_G_MAE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MAE by month ") +
xlab("month") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 12 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by month across all 8 models
g2 <- result_month_G_MAPE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MAPE by month ") +
xlab("monthcategory") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 12 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by month across all 8 models
g3 <- result_month_G_MASE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MASE by month ") +
xlab("month") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 96 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_daysprior_G_MAE_g <- gather(result_daysprior_G_MAE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
result_daysprior_G_MAPE_g <- gather(result_daysprior_G_MAPE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
result_daysprior_G_MASE_g <- gather(result_daysprior_G_MASE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
# plot MAE errors for in and out samples by days prior across all 8 models
g1 <- result_daysprior_G_MAE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MAE by days priors categories ") +
xlab("days prior category") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 6 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by days prior across all 8 models
g2 <- result_daysprior_G_MAPE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MAPE by days priors categories ") +
xlab("days prior category") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 6 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by days prior across all 8 models
g3 <- result_daysprior_G_MASE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("GLWST-Compare models with MASE by days priors categories ") +
xlab("days prior category") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 48 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_DOW_M_MAE_g <- gather(result_DOW_M_MAE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
result_DOW_M_MAPE_g <- gather(result_DOW_M_MAPE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
result_DOW_M_MASE_g <- gather(result_DOW_M_MASE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
# plot MAE errors for in and out samples by days prior across all 8 models
g1 <- result_DOW_M_MAE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MAE by Day of Week ") +
xlab("DOW") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 7 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by days prior across all 8 models
g2 <- result_DOW_M_MAPE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MAPE by Day of Week ") +
xlab("DOW") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 7 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by days prior across all 8 models
g3 <- result_DOW_M_MASE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MASE by Day of Week ") +
xlab("DOW") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 56 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_month_M_MAE_g <- gather(result_month_M_MAE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
result_month_M_MAPE_g <- gather(result_month_M_MAPE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
result_month_M_MASE_g <- gather(result_month_M_MASE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
# plot MAE errors for in and out samples by month across all 8 models
g1 <- result_month_M_MAE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MAE by month ") +
xlab("month") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 12 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by month across all 8 models
g2 <- result_month_M_MAPE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MAPE by month ") +
xlab("monthcategory") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 12 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by month across all 8 models
g3 <- result_month_M_MASE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MASE by month ") +
xlab("month") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 96 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_daysprior_M_MAE_g <- gather(result_daysprior_M_MAE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
result_daysprior_M_MAPE_g <- gather(result_daysprior_M_MAPE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
result_daysprior_M_MASE_g <- gather(result_daysprior_M_MASE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
# plot MAE errors for in and out samples by days prior across all 8 models
g1 <- result_daysprior_M_MAE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MAE by days priors categories ") +
xlab("days prior category") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 6 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by days prior across all 8 models
g2 <- result_daysprior_M_MAPE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MAPE by days priors categories ") +
xlab("days prior category") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 6 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by days prior across all 8 models
g3 <- result_daysprior_M_MASE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("MLKEP-Compare models with MASE by days priors categories ") +
xlab("days prior category") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 48 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_DOW_W_MAE_g <- gather(result_DOW_W_MAE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
result_DOW_W_MAPE_g <- gather(result_DOW_W_MAPE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
result_DOW_W_MASE_g <- gather(result_DOW_W_MASE, models, error, c(-DOW)) %>%
mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
))
# plot MAE errors for in and out samples by days prior across all 8 models
g1 <- result_DOW_W_MAE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MAE by Day of Week ") +
xlab("DOW") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 7 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by days prior across all 8 models
g2 <- result_DOW_W_MAPE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MAPE by Day of Week ") +
xlab("DOW") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 7 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by days prior across all 8 models
g3 <- result_DOW_W_MASE_g %>%
ggplot(aes(x = DOW,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MASE by Day of Week ") +
xlab("DOW") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 56 rows containing missing values (geom_point).
# manipulate data by sample, days prior group, model, and error
result_month_W_MAE_g <- gather(result_month_W_MAE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
result_month_W_MAPE_g <- gather(result_month_W_MAPE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
result_month_W_MASE_g <- gather(result_month_W_MASE, models, error, c(-month)) %>%
mutate( sample = ifelse(grepl('in', month),'in', 'out'
))
# plot MAE errors for in and out samples by month across all 8 models
g1 <- result_month_W_MAE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MAE by month ") +
xlab("month") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 12 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by month across all 8 models
g2 <- result_month_W_MAPE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MAPE by month ") +
xlab("monthcategory") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 12 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by month across all 8 models
g3 <- result_month_W_MASE_g %>%
ggplot(aes(x = month,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MASE by month ") +
xlab("month") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 96 rows containing missing values (geom_point).
Observations + in general,the additive method grouped by month and day of week produce an overall best result among all models in the training dataset, however, the accuracy flunctuated by months. + the accuracy of the testdataset grouped by month is not as robust as the training dataset, in some month it would be more accurate if only consider the DOW with additive model.
# manipulate data by sample, days prior group, model, and error
result_daysprior_W_MAE_g <- gather(result_daysprior_W_MAE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
result_daysprior_W_MAPE_g <- gather(result_daysprior_W_MAPE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
result_daysprior_W_MASE_g <- gather(result_daysprior_W_MASE, models, error, c(-days_prior_c)) %>%
mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
))
# plot MAE errors for in and out samples by days prior across all 8 models
g1 <- result_daysprior_W_MAE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MAE by days priors categories ") +
xlab("days prior category") + ylab("MAE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g1
## Warning: Removed 6 rows containing missing values (geom_point).
# plot MAPE errors for in and out samples by days prior across all 8 models
g2 <- result_daysprior_W_MAPE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MAPE by days priors categories ") +
xlab("days prior category") + ylab("MAPE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g2
## Warning: Removed 6 rows containing missing values (geom_point).
# plot MASE errors for in and out samples by days prior across all 8 models
g3 <- result_daysprior_W_MASE_g %>%
ggplot(aes(x = days_prior_c,y = error)) +
geom_point(aes(color= models),size=1.5) +
ggtitle("WARUK-Compare models with MASE by days priors categories ") +
xlab("days prior category") + ylab("MASE errors")+
coord_flip() +
scale_y_log10() +
facet_wrap(~ sample)
g3
## Warning: Removed 48 rows containing missing values (geom_point).
Observations
among all the days prior categories, 1-7 forecast the best with the most robust accuracy across 8 models under both MAE and MAPE measurements
in general,the additive method grouped by month and day of week produce an overall best result among all models measured by MAE, MAPE, especailly for hotel GLWST, and the accuaracy varies by Day of Week, the forecast of Sat for GLWST seems perform the best.
the additive method grouped by month and day of week performs better for GLWST, while naive model is the best choice for some days of week for MLKEP
# select column with interest
full_dataset <- filled_data_full %>% filter(days_prior ==0) %>% select(hotel,stay_date,final_arrivals) %>% spread(hotel,final_arrivals)
# define ts frequency for snaive model
naive_dataset_ts <- full_dataset %>% select(-stay_date) %>% ts(frequency = 364) # with 364 days seasonality
# define ts frequency for exponetial smoothing model
smoothing_dataset_ts <- full_dataset %>% select(-stay_date) %>% ts(frequency = 7) # with weekly seasonality
# assign timestamp variables
fc_timestamp<-c("6m_Nov-Apr_in","6m_Nov-Apr_out","3m_Nov-Jan_in","3m_Nov-Jan_out","3m_Dec-Feb_in","3m_Dec-Feb_out","3m_Jan-Mar_in","3m_Jan-Mar_out","3m_Feb-Apr_in","3m_Feb-Apr_out","1m_Nov_in","1m_Nov_out","1m_Dec_in","1m_Dec_out","1m_Jan_in","1m_Jan_out","1m_Feb_in","1m_Feb_out","1m_Mar_in","1m_Mar_out","1m_Apr_in","1m_Apr_out")
fc_snaive <- function(time1,time2,hotel_no,time3,time4) {
# snaive model
k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(naive_dataset_ts,end=k)
fc_ts <- snaive(training_ts[,hotel_no], h = k1)
return(fc_ts)
}
fc_ses <- function(time1,time2,hotel_no,time3,time4) {
# ses model
k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(smoothing_dataset_ts,end=k)
fc_ts <- ses(training_ts[,hotel_no], h = k1)
return(fc_ts)
}
fc_holt <- function(time1,time2,hotel_no,time3,time4) {
# holt model
k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(smoothing_dataset_ts,end=k)
fc_ts <- holt(training_ts[,hotel_no], h = k1)
return(fc_ts)
}
fc_hw <- function(time1,time2,hotel_no,time3,time4,season) {
# holt-winters model
k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(smoothing_dataset_ts,end=k)
fc_ts<- hw(training_ts[,hotel_no],h=k1,seasonal=season,damped = TRUE)
return(fc_ts)
}
fc_result <- function(hotel_no) {
# snaive forecast result
## six-month forecasting errors
six_month_snaive <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") %>% accuracy(naive_dataset_ts[,hotel_no])
## three-month forecasting errors
three_month_1_snaive <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") %>% accuracy(naive_dataset_ts[,hotel_no])
three_month_2_snaive <-fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") %>% accuracy(naive_dataset_ts[,hotel_no])
three_month_3_snaive <-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") %>% accuracy(naive_dataset_ts[,hotel_no])
three_month_4_snaive <-fc_snaive("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") %>% accuracy(naive_dataset_ts[,hotel_no])
## one-month forecasting errors
one_month_1_snaive <- fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_2_snaive <- fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_3_snaive <- fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_4_snaive <- fc_snaive("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_5_snaive <- fc_snaive("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_6_snaive <- fc_snaive("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") %>% accuracy(naive_dataset_ts[,hotel_no])
# ses forecast result
## six-month forecasting errors
six_month_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
## three-month forecasting errors
three_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_ses <-fc_ses("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
## one-month forecasting errors
one_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_ses <-fc_ses("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_ses <-fc_ses("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_ses <-fc_ses("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# holt forecast result
## six-month forecasting errors
six_month_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
## three-month forecasting errors
three_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_holt <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_holt <-fc_holt("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
## one-month forecasting errors
one_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_holt <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_holt <-fc_holt("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_holt <-fc_holt("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_holt <-fc_holt("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# hw - additive
# six-month forecasting errors
six_month_hw_a <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# three-month forecasting errors
three_month_1_hw_a <- fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_hw_a <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_hw_a <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_hw_a <- fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# one-month forecasting errors
one_month_1_hw_a <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_hw_a<-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_hw_a <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_hw_a <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_hw_a <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_hw_a <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# hw - multiplicative
# six-month forecasting errors
six_month_hw_m <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# three-month forecasting errors
three_month_1_hw_m <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_hw_m <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_hw_m <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2009-01-01","2010-03-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_hw_m <-fc_hw("2008-05-01","2010-01-30",hotel_no,"2010-02-01","2010-04-30", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# one-month forecasting errors
one_month_1_hw_m <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_hw_m <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_hw_m <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_hw_m <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_hw_m <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_hw_m <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
# combine all the result as matrix
naive_result <- rbind(six_month_snaive,three_month_1_snaive,three_month_2_snaive,three_month_3_snaive,three_month_4_snaive,one_month_1_snaive,one_month_2_snaive,one_month_3_snaive,one_month_4_snaive,one_month_5_snaive,one_month_6_snaive)
ses_result<-rbind(six_month_ses,three_month_1_ses,three_month_2_ses,three_month_3_ses,three_month_4_ses,one_month_1_ses,one_month_2_ses,one_month_3_ses,one_month_4_ses,one_month_5_ses,one_month_6_ses)
holt_result<-rbind(six_month_holt,three_month_1_holt,three_month_2_holt,three_month_3_holt,three_month_4_holt,one_month_1_holt,one_month_2_holt,one_month_3_holt,one_month_4_holt,one_month_5_holt,one_month_6_holt)
hw_add_result<-rbind(six_month_hw_a ,three_month_1_hw_a ,three_month_2_hw_a ,three_month_3_hw_a,three_month_4_hw_a,one_month_1_hw_a ,one_month_2_hw_a ,one_month_3_hw_a ,one_month_4_hw_a ,one_month_5_hw_a ,one_month_6_hw_a )
hw_mul_result<-rbind(six_month_hw_m,three_month_1_hw_m,three_month_2_hw_m,three_month_3_hw_m,three_month_4_hw_m,one_month_1_hw_m,one_month_2_hw_m,one_month_3_hw_m,one_month_4_hw_m,one_month_5_hw_m,one_month_6_hw_m)
# transfer to data frame and only keep test data result and MAE and MAPE
naive_result.df <- as.data.frame(naive_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0|row_number()%%2==1)
ses_result.df<- as.data.frame(ses_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
holt_result.df<- as.data.frame(holt_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
hw_add_result.df<- as.data.frame(hw_add_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
hw_mul_result.df<- as.data.frame(hw_mul_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
# rename the row name
naive_result<-data.frame( forecast_period = fc_timestamp, naive_result.df)
ses_result<-data.frame( forecast_period = fc_timestamp, ses_result.df)
holt_result<-data.frame( forecast_period = fc_timestamp, holt_result.df)
hw_add_result<-data.frame( forecast_period = fc_timestamp, hw_add_result.df)
hw_mul_result<-data.frame( forecast_period = fc_timestamp, hw_mul_result.df)
# calculate MASE
ses_result <- ses_result %>% mutate(MASE=as.matrix(ses_result["MAE"])/as.matrix(naive_result["MAE"]))
holt_result <- holt_result %>% mutate(MASE=as.matrix(holt_result["MAE"])/as.matrix(naive_result["MAE"]))
hw_add_result <- hw_add_result %>% mutate(MASE=as.matrix(hw_add_result["MAE"])/as.matrix(naive_result["MAE"]))
hw_mul_result <- hw_mul_result %>% mutate(MASE=as.matrix(hw_mul_result["MAE"])/as.matrix(naive_result["MAE"]))
# mutate MAPE as decimal number
ses_result <- ses_result %>% mutate(MAPE = MAPE/100)
holt_result <- holt_result %>% mutate(MAPE = MAPE/100)
hw_add_result <- hw_add_result %>% mutate(MAPE = MAPE/100)
hw_mul_result <- hw_mul_result %>% mutate(MAPE = MAPE/100)
# remove MASE for in-sample
ses_result <- ses_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
holt_result <- holt_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
hw_add_result <- hw_add_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
hw_mul_result <- hw_mul_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
return(list(naive = naive_result,ses = ses_result,holt = holt_result,hw_add = hw_add_result,hw_mul = hw_mul_result))
}
fc_result(1)
## $naive
## forecast_period MAE MAPE
## 1 6m_Nov-Apr_in 16.60000 18.05998
## 2 6m_Nov-Apr_out 19.58011 26.40135
## 3 3m_Nov-Jan_in 16.60000 18.05998
## 4 3m_Nov-Jan_out 18.17391 27.13037
## 5 3m_Dec-Feb_in 16.70233 18.12707
## 6 3m_Dec-Feb_out 16.92222 27.08021
## 7 3m_Jan-Mar_in 17.29675 20.45249
## 8 3m_Jan-Mar_out 18.82222 25.96150
## 9 3m_Feb-Apr_in 17.12274 21.07253
## 10 3m_Feb-Apr_out 21.03371 25.64776
## 11 1m_Nov_in 16.60000 18.05998
## 12 1m_Nov_out 17.33333 18.54077
## 13 1m_Dec_in 16.70233 18.12707
## 14 1m_Dec_out 21.41935 36.58038
## 15 1m_Jan_in 17.29675 20.45249
## 16 1m_Jan_out 15.74194 25.99288
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 24.28571 31.09985
## 19 1m_Mar_in 16.76721 20.76898
## 20 1m_Mar_out 26.93548 33.33250
## 21 1m_Apr_in 17.70536 21.92811
## 22 1m_Apr_out 22.20000 25.06319
##
## $ses
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 17.16472 0.2108561 NaN
## 2 6m_Nov-Apr_out 29.56734 0.5061138 1.51007031723736
## 3 3m_Nov-Jan_in 17.16472 0.2108561 NaN
## 4 3m_Nov-Jan_out 34.69838 0.6701037 1.90924101308585
## 5 3m_Dec-Feb_in 17.14492 0.2095655 NaN
## 6 3m_Dec-Feb_out 31.32584 0.5987116 1.85116595265857
## 7 3m_Jan-Mar_in 17.62643 0.2221101 NaN
## 8 3m_Jan-Mar_out 23.17962 0.3181623 1.23150299808857
## 9 3m_Feb-Apr_in 17.48667 0.2230310 NaN
## 10 3m_Feb-Apr_out 23.26497 0.2405159 1.10608052462494
## 11 1m_Nov_in 17.16472 0.2108561 NaN
## 12 1m_Nov_out 17.12180 0.1985084 0.987796146118206
## 13 1m_Dec_in 17.14492 0.2095655 NaN
## 14 1m_Dec_out 31.91392 0.6757493 1.4899569826427
## 15 1m_Jan_in 17.62643 0.2221101 NaN
## 16 1m_Jan_out 23.07441 0.4614499 1.46579268309207
## 17 1m_Feb_in 17.98274 0.2336794 NaN
## 18 1m_Feb_out 22.95372 0.3156966 0.945153313792086
## 19 1m_Mar_in 17.55837 0.2231886 NaN
## 20 1m_Mar_out 23.50660 0.2679289 0.872700225739768
## 21 1m_Apr_in 17.73291 0.2250199 NaN
## 22 1m_Apr_out 20.98610 0.2778388 0.945319629121382
##
## $holt
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 17.13131 0.2106789 NaN
## 2 6m_Nov-Apr_out 30.70201 0.5241845 1.56802032878809
## 3 3m_Nov-Jan_in 17.13131 0.2106789 NaN
## 4 3m_Nov-Jan_out 35.46322 0.6845672 1.95132532723337
## 5 3m_Dec-Feb_in 17.12651 0.2093029 NaN
## 6 3m_Dec-Feb_out 31.26093 0.5973831 1.8473298401296
## 7 3m_Jan-Mar_in 17.63378 0.2216822 NaN
## 8 3m_Jan-Mar_out 23.73684 0.3190124 1.26110703952513
## 9 3m_Feb-Apr_in 17.49045 0.2225737 NaN
## 10 3m_Feb-Apr_out 24.07563 0.2452765 1.14462111892475
## 11 1m_Nov_in 17.13131 0.2106789 NaN
## 12 1m_Nov_out 17.26091 0.2005270 0.995821556838069
## 13 1m_Dec_in 17.12651 0.2093029 NaN
## 14 1m_Dec_out 31.88626 0.6750160 1.48866583852698
## 15 1m_Jan_in 17.63378 0.2216822 NaN
## 16 1m_Jan_out 22.93960 0.4567448 1.45722866851363
## 17 1m_Feb_in 17.49045 0.2225737 NaN
## 18 1m_Feb_out 20.46945 0.2174224 0.842859605534413
## 19 1m_Mar_in 17.55315 0.2227842 NaN
## 20 1m_Mar_out 23.66548 0.2683444 0.878598827909082
## 21 1m_Apr_in 17.71103 0.2248767 NaN
## 22 1m_Apr_out 21.30267 0.2819059 0.959579656671636
##
## $hw_add
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 14.23579 0.1677099 NaN
## 2 6m_Nov-Apr_out 24.39895 0.4202772 1.24610869159936
## 3 3m_Nov-Jan_in 14.23579 0.1677099 NaN
## 4 3m_Nov-Jan_out 28.91156 0.5722553 1.59082739119975
## 5 3m_Dec-Feb_in 14.03028 0.1644125 NaN
## 6 3m_Dec-Feb_out 31.17146 0.6116655 1.84204320025238
## 7 3m_Jan-Mar_in 14.47323 0.1735547 NaN
## 8 3m_Jan-Mar_out 24.72472 0.4175608 1.31359172056293
## 9 3m_Feb-Apr_in 14.55219 0.1787784 NaN
## 10 3m_Feb-Apr_out 20.84123 0.2081257 0.990849252153732
## 11 1m_Nov_in 14.23579 0.1677099 NaN
## 12 1m_Nov_out 11.89435 0.1286130 0.686212323034542
## 13 1m_Dec_in 14.03028 0.1644125 NaN
## 14 1m_Dec_out 30.40857 0.6878321 1.41967708388251
## 15 1m_Jan_in 14.47323 0.1735547 NaN
## 16 1m_Jan_out 36.65615 0.7486518 2.32856705580899
## 17 1m_Feb_in 14.55219 0.1787784 NaN
## 18 1m_Feb_out 17.53358 0.1833935 0.721970880917249
## 19 1m_Mar_in 14.58160 0.1785943 NaN
## 20 1m_Mar_out 18.45737 0.2129133 0.685243730902185
## 21 1m_Apr_in 14.59907 0.1787301 NaN
## 22 1m_Apr_out 24.28184 0.3053951 1.09377652193263
##
## $hw_mul
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 14.68280 0.1725621 NaN
## 2 6m_Nov-Apr_out 24.82579 0.4277763 1.2679087638248
## 3 3m_Nov-Jan_in 14.68280 0.1725621 NaN
## 4 3m_Nov-Jan_out 29.40811 0.5808797 1.61814948410176
## 5 3m_Dec-Feb_in 14.54415 0.1705139 NaN
## 6 3m_Dec-Feb_out 30.20617 0.5924527 1.78500014535895
## 7 3m_Jan-Mar_in 14.83175 0.1770651 NaN
## 8 3m_Jan-Mar_out 21.86841 0.3419958 1.16183997927205
## 9 3m_Feb-Apr_in 14.79067 0.1791103 NaN
## 10 3m_Feb-Apr_out 18.11542 0.2121346 0.86125672682618
## 11 1m_Nov_in 14.68280 0.1725621 NaN
## 12 1m_Nov_out 12.17564 0.1328571 0.702440627424316
## 13 1m_Dec_in 14.54415 0.1705139 NaN
## 14 1m_Dec_out 30.03456 0.6715978 1.40221584981471
## 15 1m_Jan_in 14.83175 0.1770651 NaN
## 16 1m_Jan_out 33.55495 0.6932201 2.13156450930606
## 17 1m_Feb_in 14.80548 0.1797262 NaN
## 18 1m_Feb_out 19.02115 0.1945147 0.783223727928355
## 19 1m_Mar_in 14.82875 0.1794635 NaN
## 20 1m_Mar_out 20.02641 0.2262414 0.743495441486405
## 21 1m_Apr_in 14.93417 0.1813381 NaN
## 22 1m_Apr_out 24.55066 0.3060608 1.10588551357609
fc_result_across <- function(hotel_no) {k<-fc_result(hotel_no)
MAE <-data.frame(forecast_period= k[["naive"]][,1],ses=k[["ses"]][,2],holt=k[["holt"]][,2],hw_add=k[["hw_add"]][,2],hw_mul=k[["hw_mul"]][,2])
MAPE <-data.frame(forecast_period =k[["naive"]][,1],ses=k[["ses"]][,3],holt=k[["holt"]][,3],hw_add=k[["hw_add"]][,3],hw_mul=k[["hw_mul"]][,3])
MASE <- data.frame( forecast_period =k[["naive"]][,1],ses=k[["ses"]][,4],holt=k[["holt"]][,4],hw_add=k[["hw_add"]][,4],hw_mul=k[["hw_mul"]][,4])
return(list(MAE=MAE, MAPE=MAPE,MASE=MASE))
}
fc_result(1)
## $naive
## forecast_period MAE MAPE
## 1 6m_Nov-Apr_in 16.60000 18.05998
## 2 6m_Nov-Apr_out 19.58011 26.40135
## 3 3m_Nov-Jan_in 16.60000 18.05998
## 4 3m_Nov-Jan_out 18.17391 27.13037
## 5 3m_Dec-Feb_in 16.70233 18.12707
## 6 3m_Dec-Feb_out 16.92222 27.08021
## 7 3m_Jan-Mar_in 17.29675 20.45249
## 8 3m_Jan-Mar_out 18.82222 25.96150
## 9 3m_Feb-Apr_in 17.12274 21.07253
## 10 3m_Feb-Apr_out 21.03371 25.64776
## 11 1m_Nov_in 16.60000 18.05998
## 12 1m_Nov_out 17.33333 18.54077
## 13 1m_Dec_in 16.70233 18.12707
## 14 1m_Dec_out 21.41935 36.58038
## 15 1m_Jan_in 17.29675 20.45249
## 16 1m_Jan_out 15.74194 25.99288
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 24.28571 31.09985
## 19 1m_Mar_in 16.76721 20.76898
## 20 1m_Mar_out 26.93548 33.33250
## 21 1m_Apr_in 17.70536 21.92811
## 22 1m_Apr_out 22.20000 25.06319
##
## $ses
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 17.16472 0.2108561 NaN
## 2 6m_Nov-Apr_out 29.56734 0.5061138 1.51007031723736
## 3 3m_Nov-Jan_in 17.16472 0.2108561 NaN
## 4 3m_Nov-Jan_out 34.69838 0.6701037 1.90924101308585
## 5 3m_Dec-Feb_in 17.14492 0.2095655 NaN
## 6 3m_Dec-Feb_out 31.32584 0.5987116 1.85116595265857
## 7 3m_Jan-Mar_in 17.62643 0.2221101 NaN
## 8 3m_Jan-Mar_out 23.17962 0.3181623 1.23150299808857
## 9 3m_Feb-Apr_in 17.48667 0.2230310 NaN
## 10 3m_Feb-Apr_out 23.26497 0.2405159 1.10608052462494
## 11 1m_Nov_in 17.16472 0.2108561 NaN
## 12 1m_Nov_out 17.12180 0.1985084 0.987796146118206
## 13 1m_Dec_in 17.14492 0.2095655 NaN
## 14 1m_Dec_out 31.91392 0.6757493 1.4899569826427
## 15 1m_Jan_in 17.62643 0.2221101 NaN
## 16 1m_Jan_out 23.07441 0.4614499 1.46579268309207
## 17 1m_Feb_in 17.98274 0.2336794 NaN
## 18 1m_Feb_out 22.95372 0.3156966 0.945153313792086
## 19 1m_Mar_in 17.55837 0.2231886 NaN
## 20 1m_Mar_out 23.50660 0.2679289 0.872700225739768
## 21 1m_Apr_in 17.73291 0.2250199 NaN
## 22 1m_Apr_out 20.98610 0.2778388 0.945319629121382
##
## $holt
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 17.13131 0.2106789 NaN
## 2 6m_Nov-Apr_out 30.70201 0.5241845 1.56802032878809
## 3 3m_Nov-Jan_in 17.13131 0.2106789 NaN
## 4 3m_Nov-Jan_out 35.46322 0.6845672 1.95132532723337
## 5 3m_Dec-Feb_in 17.12651 0.2093029 NaN
## 6 3m_Dec-Feb_out 31.26093 0.5973831 1.8473298401296
## 7 3m_Jan-Mar_in 17.63378 0.2216822 NaN
## 8 3m_Jan-Mar_out 23.73684 0.3190124 1.26110703952513
## 9 3m_Feb-Apr_in 17.49045 0.2225737 NaN
## 10 3m_Feb-Apr_out 24.07563 0.2452765 1.14462111892475
## 11 1m_Nov_in 17.13131 0.2106789 NaN
## 12 1m_Nov_out 17.26091 0.2005270 0.995821556838069
## 13 1m_Dec_in 17.12651 0.2093029 NaN
## 14 1m_Dec_out 31.88626 0.6750160 1.48866583852698
## 15 1m_Jan_in 17.63378 0.2216822 NaN
## 16 1m_Jan_out 22.93960 0.4567448 1.45722866851363
## 17 1m_Feb_in 17.49045 0.2225737 NaN
## 18 1m_Feb_out 20.46945 0.2174224 0.842859605534413
## 19 1m_Mar_in 17.55315 0.2227842 NaN
## 20 1m_Mar_out 23.66548 0.2683444 0.878598827909082
## 21 1m_Apr_in 17.71103 0.2248767 NaN
## 22 1m_Apr_out 21.30267 0.2819059 0.959579656671636
##
## $hw_add
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 14.23579 0.1677099 NaN
## 2 6m_Nov-Apr_out 24.39895 0.4202772 1.24610869159936
## 3 3m_Nov-Jan_in 14.23579 0.1677099 NaN
## 4 3m_Nov-Jan_out 28.91156 0.5722553 1.59082739119975
## 5 3m_Dec-Feb_in 14.03028 0.1644125 NaN
## 6 3m_Dec-Feb_out 31.17146 0.6116655 1.84204320025238
## 7 3m_Jan-Mar_in 14.47323 0.1735547 NaN
## 8 3m_Jan-Mar_out 24.72472 0.4175608 1.31359172056293
## 9 3m_Feb-Apr_in 14.55219 0.1787784 NaN
## 10 3m_Feb-Apr_out 20.84123 0.2081257 0.990849252153732
## 11 1m_Nov_in 14.23579 0.1677099 NaN
## 12 1m_Nov_out 11.89435 0.1286130 0.686212323034542
## 13 1m_Dec_in 14.03028 0.1644125 NaN
## 14 1m_Dec_out 30.40857 0.6878321 1.41967708388251
## 15 1m_Jan_in 14.47323 0.1735547 NaN
## 16 1m_Jan_out 36.65615 0.7486518 2.32856705580899
## 17 1m_Feb_in 14.55219 0.1787784 NaN
## 18 1m_Feb_out 17.53358 0.1833935 0.721970880917249
## 19 1m_Mar_in 14.58160 0.1785943 NaN
## 20 1m_Mar_out 18.45737 0.2129133 0.685243730902185
## 21 1m_Apr_in 14.59907 0.1787301 NaN
## 22 1m_Apr_out 24.28184 0.3053951 1.09377652193263
##
## $hw_mul
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 14.68280 0.1725621 NaN
## 2 6m_Nov-Apr_out 24.82579 0.4277763 1.2679087638248
## 3 3m_Nov-Jan_in 14.68280 0.1725621 NaN
## 4 3m_Nov-Jan_out 29.40811 0.5808797 1.61814948410176
## 5 3m_Dec-Feb_in 14.54415 0.1705139 NaN
## 6 3m_Dec-Feb_out 30.20617 0.5924527 1.78500014535895
## 7 3m_Jan-Mar_in 14.83175 0.1770651 NaN
## 8 3m_Jan-Mar_out 21.86841 0.3419958 1.16183997927205
## 9 3m_Feb-Apr_in 14.79067 0.1791103 NaN
## 10 3m_Feb-Apr_out 18.11542 0.2121346 0.86125672682618
## 11 1m_Nov_in 14.68280 0.1725621 NaN
## 12 1m_Nov_out 12.17564 0.1328571 0.702440627424316
## 13 1m_Dec_in 14.54415 0.1705139 NaN
## 14 1m_Dec_out 30.03456 0.6715978 1.40221584981471
## 15 1m_Jan_in 14.83175 0.1770651 NaN
## 16 1m_Jan_out 33.55495 0.6932201 2.13156450930606
## 17 1m_Feb_in 14.80548 0.1797262 NaN
## 18 1m_Feb_out 19.02115 0.1945147 0.783223727928355
## 19 1m_Mar_in 14.82875 0.1794635 NaN
## 20 1m_Mar_out 20.02641 0.2262414 0.743495441486405
## 21 1m_Apr_in 14.93417 0.1813381 NaN
## 22 1m_Apr_out 24.55066 0.3060608 1.10588551357609
fc_result_across(1)
## $MAE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 17.16472 17.13131 14.23579 14.68280
## 2 6m_Nov-Apr_out 29.56734 30.70201 24.39895 24.82579
## 3 3m_Nov-Jan_in 17.16472 17.13131 14.23579 14.68280
## 4 3m_Nov-Jan_out 34.69838 35.46322 28.91156 29.40811
## 5 3m_Dec-Feb_in 17.14492 17.12651 14.03028 14.54415
## 6 3m_Dec-Feb_out 31.32584 31.26093 31.17146 30.20617
## 7 3m_Jan-Mar_in 17.62643 17.63378 14.47323 14.83175
## 8 3m_Jan-Mar_out 23.17962 23.73684 24.72472 21.86841
## 9 3m_Feb-Apr_in 17.48667 17.49045 14.55219 14.79067
## 10 3m_Feb-Apr_out 23.26497 24.07563 20.84123 18.11542
## 11 1m_Nov_in 17.16472 17.13131 14.23579 14.68280
## 12 1m_Nov_out 17.12180 17.26091 11.89435 12.17564
## 13 1m_Dec_in 17.14492 17.12651 14.03028 14.54415
## 14 1m_Dec_out 31.91392 31.88626 30.40857 30.03456
## 15 1m_Jan_in 17.62643 17.63378 14.47323 14.83175
## 16 1m_Jan_out 23.07441 22.93960 36.65615 33.55495
## 17 1m_Feb_in 17.98274 17.49045 14.55219 14.80548
## 18 1m_Feb_out 22.95372 20.46945 17.53358 19.02115
## 19 1m_Mar_in 17.55837 17.55315 14.58160 14.82875
## 20 1m_Mar_out 23.50660 23.66548 18.45737 20.02641
## 21 1m_Apr_in 17.73291 17.71103 14.59907 14.93417
## 22 1m_Apr_out 20.98610 21.30267 24.28184 24.55066
##
## $MAPE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 0.2108561 0.2106789 0.1677099 0.1725621
## 2 6m_Nov-Apr_out 0.5061138 0.5241845 0.4202772 0.4277763
## 3 3m_Nov-Jan_in 0.2108561 0.2106789 0.1677099 0.1725621
## 4 3m_Nov-Jan_out 0.6701037 0.6845672 0.5722553 0.5808797
## 5 3m_Dec-Feb_in 0.2095655 0.2093029 0.1644125 0.1705139
## 6 3m_Dec-Feb_out 0.5987116 0.5973831 0.6116655 0.5924527
## 7 3m_Jan-Mar_in 0.2221101 0.2216822 0.1735547 0.1770651
## 8 3m_Jan-Mar_out 0.3181623 0.3190124 0.4175608 0.3419958
## 9 3m_Feb-Apr_in 0.2230310 0.2225737 0.1787784 0.1791103
## 10 3m_Feb-Apr_out 0.2405159 0.2452765 0.2081257 0.2121346
## 11 1m_Nov_in 0.2108561 0.2106789 0.1677099 0.1725621
## 12 1m_Nov_out 0.1985084 0.2005270 0.1286130 0.1328571
## 13 1m_Dec_in 0.2095655 0.2093029 0.1644125 0.1705139
## 14 1m_Dec_out 0.6757493 0.6750160 0.6878321 0.6715978
## 15 1m_Jan_in 0.2221101 0.2216822 0.1735547 0.1770651
## 16 1m_Jan_out 0.4614499 0.4567448 0.7486518 0.6932201
## 17 1m_Feb_in 0.2336794 0.2225737 0.1787784 0.1797262
## 18 1m_Feb_out 0.3156966 0.2174224 0.1833935 0.1945147
## 19 1m_Mar_in 0.2231886 0.2227842 0.1785943 0.1794635
## 20 1m_Mar_out 0.2679289 0.2683444 0.2129133 0.2262414
## 21 1m_Apr_in 0.2250199 0.2248767 0.1787301 0.1813381
## 22 1m_Apr_out 0.2778388 0.2819059 0.3053951 0.3060608
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 1.51007031723736 1.56802032878809 1.24610869159936
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 1.90924101308585 1.95132532723337 1.59082739119975
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 1.85116595265857 1.8473298401296 1.84204320025238
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 1.23150299808857 1.26110703952513 1.31359172056293
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 1.10608052462494 1.14462111892475 0.990849252153732
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 0.987796146118206 0.995821556838069 0.686212323034542
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 1.4899569826427 1.48866583852698 1.41967708388251
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 1.46579268309207 1.45722866851363 2.32856705580899
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.945153313792086 0.842859605534413 0.721970880917249
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 0.872700225739768 0.878598827909082 0.685243730902185
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 0.945319629121382 0.959579656671636 1.09377652193263
## hw_mul
## 1 NaN
## 2 1.2679087638248
## 3 NaN
## 4 1.61814948410176
## 5 NaN
## 6 1.78500014535895
## 7 NaN
## 8 1.16183997927205
## 9 NaN
## 10 0.86125672682618
## 11 NaN
## 12 0.702440627424316
## 13 NaN
## 14 1.40221584981471
## 15 NaN
## 16 2.13156450930606
## 17 NaN
## 18 0.783223727928355
## 19 NaN
## 20 0.743495441486405
## 21 NaN
## 22 1.10588551357609
fc_timestamp_out<-c("6m_Nov-Apr_out","3m_Nov-Jan_out","3m_Dec-Feb_out","3m_Jan-Mar_out","3m_Feb-Apr_out","1m_Nov_out","1m_Dec_out","1m_Jan_out","1m_Feb_out","1m_Mar_out","1m_Apr_out")
fc_result_across(1)
## $MAE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 17.16472 17.13131 14.23579 14.68280
## 2 6m_Nov-Apr_out 29.56734 30.70201 24.39895 24.82579
## 3 3m_Nov-Jan_in 17.16472 17.13131 14.23579 14.68280
## 4 3m_Nov-Jan_out 34.69838 35.46322 28.91156 29.40811
## 5 3m_Dec-Feb_in 17.14492 17.12651 14.03028 14.54415
## 6 3m_Dec-Feb_out 31.32584 31.26093 31.17146 30.20617
## 7 3m_Jan-Mar_in 17.62643 17.63378 14.47323 14.83175
## 8 3m_Jan-Mar_out 23.17962 23.73684 24.72472 21.86841
## 9 3m_Feb-Apr_in 17.48667 17.49045 14.55219 14.79067
## 10 3m_Feb-Apr_out 23.26497 24.07563 20.84123 18.11542
## 11 1m_Nov_in 17.16472 17.13131 14.23579 14.68280
## 12 1m_Nov_out 17.12180 17.26091 11.89435 12.17564
## 13 1m_Dec_in 17.14492 17.12651 14.03028 14.54415
## 14 1m_Dec_out 31.91392 31.88626 30.40857 30.03456
## 15 1m_Jan_in 17.62643 17.63378 14.47323 14.83175
## 16 1m_Jan_out 23.07441 22.93960 36.65615 33.55495
## 17 1m_Feb_in 17.98274 17.49045 14.55219 14.80548
## 18 1m_Feb_out 22.95372 20.46945 17.53358 19.02115
## 19 1m_Mar_in 17.55837 17.55315 14.58160 14.82875
## 20 1m_Mar_out 23.50660 23.66548 18.45737 20.02641
## 21 1m_Apr_in 17.73291 17.71103 14.59907 14.93417
## 22 1m_Apr_out 20.98610 21.30267 24.28184 24.55066
##
## $MAPE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 0.2108561 0.2106789 0.1677099 0.1725621
## 2 6m_Nov-Apr_out 0.5061138 0.5241845 0.4202772 0.4277763
## 3 3m_Nov-Jan_in 0.2108561 0.2106789 0.1677099 0.1725621
## 4 3m_Nov-Jan_out 0.6701037 0.6845672 0.5722553 0.5808797
## 5 3m_Dec-Feb_in 0.2095655 0.2093029 0.1644125 0.1705139
## 6 3m_Dec-Feb_out 0.5987116 0.5973831 0.6116655 0.5924527
## 7 3m_Jan-Mar_in 0.2221101 0.2216822 0.1735547 0.1770651
## 8 3m_Jan-Mar_out 0.3181623 0.3190124 0.4175608 0.3419958
## 9 3m_Feb-Apr_in 0.2230310 0.2225737 0.1787784 0.1791103
## 10 3m_Feb-Apr_out 0.2405159 0.2452765 0.2081257 0.2121346
## 11 1m_Nov_in 0.2108561 0.2106789 0.1677099 0.1725621
## 12 1m_Nov_out 0.1985084 0.2005270 0.1286130 0.1328571
## 13 1m_Dec_in 0.2095655 0.2093029 0.1644125 0.1705139
## 14 1m_Dec_out 0.6757493 0.6750160 0.6878321 0.6715978
## 15 1m_Jan_in 0.2221101 0.2216822 0.1735547 0.1770651
## 16 1m_Jan_out 0.4614499 0.4567448 0.7486518 0.6932201
## 17 1m_Feb_in 0.2336794 0.2225737 0.1787784 0.1797262
## 18 1m_Feb_out 0.3156966 0.2174224 0.1833935 0.1945147
## 19 1m_Mar_in 0.2231886 0.2227842 0.1785943 0.1794635
## 20 1m_Mar_out 0.2679289 0.2683444 0.2129133 0.2262414
## 21 1m_Apr_in 0.2250199 0.2248767 0.1787301 0.1813381
## 22 1m_Apr_out 0.2778388 0.2819059 0.3053951 0.3060608
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 1.51007031723736 1.56802032878809 1.24610869159936
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 1.90924101308585 1.95132532723337 1.59082739119975
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 1.85116595265857 1.8473298401296 1.84204320025238
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 1.23150299808857 1.26110703952513 1.31359172056293
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 1.10608052462494 1.14462111892475 0.990849252153732
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 0.987796146118206 0.995821556838069 0.686212323034542
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 1.4899569826427 1.48866583852698 1.41967708388251
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 1.46579268309207 1.45722866851363 2.32856705580899
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.945153313792086 0.842859605534413 0.721970880917249
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 0.872700225739768 0.878598827909082 0.685243730902185
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 0.945319629121382 0.959579656671636 1.09377652193263
## hw_mul
## 1 NaN
## 2 1.2679087638248
## 3 NaN
## 4 1.61814948410176
## 5 NaN
## 6 1.78500014535895
## 7 NaN
## 8 1.16183997927205
## 9 NaN
## 10 0.86125672682618
## 11 NaN
## 12 0.702440627424316
## 13 NaN
## 14 1.40221584981471
## 15 NaN
## 16 2.13156450930606
## 17 NaN
## 18 0.783223727928355
## 19 NaN
## 20 0.743495441486405
## 21 NaN
## 22 1.10588551357609
es_G_MAE <- data.frame(fc_result_across(1)[1])
es_G_MAPE<- data.frame(fc_result_across(1)[2])
es_G_MASE<- data.frame(fc_result_across(1)[3]) %>% filter(row_number()%%2 ==0)
es_G_MASE<-txtRound(es_G_MASE[,-1],2)
es_G_MASE <- data.frame(forecast_period=fc_timestamp_out,es_G_MASE)
htmlTable(es_G_MASE)
| forecast_period | MASE.ses | MASE.holt | MASE.hw_add | MASE.hw_mul | |
|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 1.51 | 1.57 | 1.25 | 1.27 |
| 2 | 3m_Nov-Jan_out | 1.91 | 1.95 | 1.59 | 1.62 |
| 3 | 3m_Dec-Feb_out | 1.85 | 1.85 | 1.84 | 1.79 |
| 4 | 3m_Jan-Mar_out | 1.23 | 1.26 | 1.31 | 1.16 |
| 5 | 3m_Feb-Apr_out | 1.11 | 1.14 | 0.99 | 0.86 |
| 6 | 1m_Nov_out | 0.99 | 1.00 | 0.69 | 0.70 |
| 7 | 1m_Dec_out | 1.49 | 1.49 | 1.42 | 1.40 |
| 8 | 1m_Jan_out | 1.47 | 1.46 | 2.33 | 2.13 |
| 9 | 1m_Feb_out | 0.95 | 0.84 | 0.72 | 0.78 |
| 10 | 1m_Mar_out | 0.87 | 0.88 | 0.69 | 0.74 |
| 11 | 1m_Apr_out | 0.95 | 0.96 | 1.09 | 1.11 |
fc_result(2)
## $naive
## forecast_period MAE MAPE
## 1 6m_Nov-Apr_in 35.92432 37.03705
## 2 6m_Nov-Apr_out 18.78453 26.12411
## 3 3m_Nov-Jan_in 35.92432 37.03705
## 4 3m_Nov-Jan_out 19.17391 29.66703
## 5 3m_Dec-Feb_in 33.79535 35.00399
## 6 3m_Dec-Feb_out 16.98889 27.86406
## 7 3m_Jan-Mar_in 32.08537 34.98210
## 8 3m_Jan-Mar_out 15.92222 22.51215
## 9 3m_Feb-Apr_in 30.36101 34.58924
## 10 3m_Feb-Apr_out 18.38202 22.46177
## 11 1m_Nov_in 35.92432 37.03705
## 12 1m_Nov_out 20.66667 22.46676
## 13 1m_Dec_in 33.79535 35.00399
## 14 1m_Dec_out 20.22581 34.83032
## 15 1m_Jan_in 32.08537 34.98210
## 16 1m_Jan_out 16.67742 31.47174
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 61.85714 72.01797
## 19 1m_Mar_in 28.83607 32.89712
## 20 1m_Mar_out 17.12903 19.29251
## 21 1m_Apr_in 27.75595 31.64194
## 22 1m_Apr_out 24.00000 31.62092
##
## $ses
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 38.77455 0.6473017 NaN
## 2 6m_Nov-Apr_out 45.49341 0.6153640 2.42185488485271
## 3 3m_Nov-Jan_in 38.77455 0.6473017 NaN
## 4 3m_Nov-Jan_out 47.99566 0.7401124 2.50317495996648
## 5 3m_Dec-Feb_in 39.16804 0.6428962 NaN
## 6 3m_Dec-Feb_out 50.00241 1.1311959 2.94324218994747
## 7 3m_Jan-Mar_in 39.39255 0.6515307 NaN
## 8 3m_Jan-Mar_out 50.20995 0.5595839 3.15345143621606
## 9 3m_Feb-Apr_in 39.80263 0.6625364 NaN
## 10 3m_Feb-Apr_out 41.25520 0.5546310 2.24432329807167
## 11 1m_Nov_in 38.77455 0.6473017 NaN
## 12 1m_Nov_out 51.26677 0.4941932 2.48065023694255
## 13 1m_Dec_in 39.16804 0.6428962 NaN
## 14 1m_Dec_out 53.11451 1.1402568 2.62607600778802
## 15 1m_Jan_in 39.39255 0.6515307 NaN
## 16 1m_Jan_out 47.38678 0.7364310 2.84137377443743
## 17 1m_Feb_in 37.75368 0.6856247 NaN
## 18 1m_Feb_out 41.83729 0.6715170 0.676353494652262
## 19 1m_Mar_in 39.82918 0.6603712 NaN
## 20 1m_Mar_out 43.19087 0.5349947 2.52150109191934
## 21 1m_Apr_in 40.01951 0.6597906 NaN
## 22 1m_Apr_out 41.47564 0.6605126 1.72815186029591
##
## $holt
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 38.77184 0.6530131 NaN
## 2 6m_Nov-Apr_out 45.18002 0.6353902 2.40517140567444
## 3 3m_Nov-Jan_in 38.77184 0.6530131 NaN
## 4 3m_Nov-Jan_out 48.14022 0.7608638 2.51071420616879
## 5 3m_Dec-Feb_in 39.15002 0.6521671 NaN
## 6 3m_Dec-Feb_out 51.81970 1.2004435 3.05021113893062
## 7 3m_Jan-Mar_in 39.39627 0.6538105 NaN
## 8 3m_Jan-Mar_out 50.49698 0.5582343 3.17147789239688
## 9 3m_Feb-Apr_in 39.80379 0.6674092 NaN
## 10 3m_Feb-Apr_out 40.99548 0.5695227 2.23019396058413
## 11 1m_Nov_in 38.77184 0.6530131 NaN
## 12 1m_Nov_out 51.00898 0.4954742 2.46817641736297
## 13 1m_Dec_in 39.15002 0.6521671 NaN
## 14 1m_Dec_out 54.45684 1.1848696 2.69244325136226
## 15 1m_Jan_in 39.39627 0.6538105 NaN
## 16 1m_Jan_out 47.48135 0.7317912 2.84704398921894
## 17 1m_Feb_in 39.80379 0.6674092 NaN
## 18 1m_Feb_out 38.40744 0.5613361 0.620905457428594
## 19 1m_Mar_in 39.83565 0.6656321 NaN
## 20 1m_Mar_out 42.83800 0.5384868 2.50090002175195
## 21 1m_Apr_in 40.02174 0.6658463 NaN
## 22 1m_Apr_out 41.52681 0.6709377 1.73028354206183
##
## $hw_add
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 21.18071 0.3412081 NaN
## 2 6m_Nov-Apr_out 40.44032 0.5024606 2.15285208085992
## 3 3m_Nov-Jan_in 21.18071 0.3412081 NaN
## 4 3m_Nov-Jan_out 43.31319 0.5902200 2.2589643205019
## 5 3m_Dec-Feb_in 21.04567 0.3352257 NaN
## 6 3m_Dec-Feb_out 33.81385 0.8216322 1.99035089593933
## 7 3m_Jan-Mar_in 21.49253 0.3512270 NaN
## 8 3m_Jan-Mar_out 72.18988 0.9358860 4.53390757349255
## 9 3m_Feb-Apr_in 21.73913 0.3611149 NaN
## 10 3m_Feb-Apr_out 19.07638 0.2145234 1.03777373155899
## 11 1m_Nov_in 21.18071 0.3412081 NaN
## 12 1m_Nov_out 49.68810 0.4818548 2.40426284125621
## 13 1m_Dec_in 21.04567 0.3352257 NaN
## 14 1m_Dec_out 41.05527 1.0512742 2.02984596452465
## 15 1m_Jan_in 21.49253 0.3512270 NaN
## 16 1m_Jan_out 63.69622 0.9687336 3.81930887153841
## 17 1m_Feb_in 21.73913 0.3611149 NaN
## 18 1m_Feb_out 13.61814 0.1660205 0.220154760923705
## 19 1m_Mar_in 21.39390 0.3539051 NaN
## 20 1m_Mar_out 19.74626 0.1909887 1.15279466596787
## 21 1m_Apr_in 21.21729 0.3482126 NaN
## 22 1m_Apr_out 28.07609 0.3355028 1.16983687695675
##
## $hw_mul
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 20.90222 0.3028179 NaN
## 2 6m_Nov-Apr_out 46.23437 0.4668452 2.46130027007225
## 3 3m_Nov-Jan_in 20.90222 0.3028179 NaN
## 4 3m_Nov-Jan_out 46.65270 0.5149623 2.43313398617843
## 5 3m_Dec-Feb_in 20.98880 0.2980816 NaN
## 6 3m_Dec-Feb_out 31.80701 0.7622298 1.87222417169747
## 7 3m_Jan-Mar_in 21.03735 0.3050282 NaN
## 8 3m_Jan-Mar_out 60.41168 0.5931100 3.7941741061251
## 9 3m_Feb-Apr_in 20.74706 0.3094236 NaN
## 10 3m_Feb-Apr_out 29.57399 0.2689125 1.60885381507066
## 11 1m_Nov_in 20.90222 0.3028179 NaN
## 12 1m_Nov_out 55.99825 0.4579445 2.70959288322267
## 13 1m_Dec_in 20.98880 0.2980816 NaN
## 14 1m_Dec_out 38.70986 0.9927841 1.91388482490275
## 15 1m_Jan_in 21.03735 0.3050282 NaN
## 16 1m_Jan_out 51.55298 0.5470016 3.09118460927018
## 17 1m_Feb_in 20.82137 0.3106785 NaN
## 18 1m_Feb_out 19.70531 0.1947078 0.318561626986709
## 19 1m_Mar_in 20.43778 0.3023790 NaN
## 20 1m_Mar_out 23.01562 0.2088241 1.34366115083376
## 21 1m_Apr_in 20.25453 0.2990208 NaN
## 22 1m_Apr_out 26.44477 0.2833986 1.101865510774
fc_result_across(2)
## $MAE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 38.77455 38.77184 21.18071 20.90222
## 2 6m_Nov-Apr_out 45.49341 45.18002 40.44032 46.23437
## 3 3m_Nov-Jan_in 38.77455 38.77184 21.18071 20.90222
## 4 3m_Nov-Jan_out 47.99566 48.14022 43.31319 46.65270
## 5 3m_Dec-Feb_in 39.16804 39.15002 21.04567 20.98880
## 6 3m_Dec-Feb_out 50.00241 51.81970 33.81385 31.80701
## 7 3m_Jan-Mar_in 39.39255 39.39627 21.49253 21.03735
## 8 3m_Jan-Mar_out 50.20995 50.49698 72.18988 60.41168
## 9 3m_Feb-Apr_in 39.80263 39.80379 21.73913 20.74706
## 10 3m_Feb-Apr_out 41.25520 40.99548 19.07638 29.57399
## 11 1m_Nov_in 38.77455 38.77184 21.18071 20.90222
## 12 1m_Nov_out 51.26677 51.00898 49.68810 55.99825
## 13 1m_Dec_in 39.16804 39.15002 21.04567 20.98880
## 14 1m_Dec_out 53.11451 54.45684 41.05527 38.70986
## 15 1m_Jan_in 39.39255 39.39627 21.49253 21.03735
## 16 1m_Jan_out 47.38678 47.48135 63.69622 51.55298
## 17 1m_Feb_in 37.75368 39.80379 21.73913 20.82137
## 18 1m_Feb_out 41.83729 38.40744 13.61814 19.70531
## 19 1m_Mar_in 39.82918 39.83565 21.39390 20.43778
## 20 1m_Mar_out 43.19087 42.83800 19.74626 23.01562
## 21 1m_Apr_in 40.01951 40.02174 21.21729 20.25453
## 22 1m_Apr_out 41.47564 41.52681 28.07609 26.44477
##
## $MAPE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 0.6473017 0.6530131 0.3412081 0.3028179
## 2 6m_Nov-Apr_out 0.6153640 0.6353902 0.5024606 0.4668452
## 3 3m_Nov-Jan_in 0.6473017 0.6530131 0.3412081 0.3028179
## 4 3m_Nov-Jan_out 0.7401124 0.7608638 0.5902200 0.5149623
## 5 3m_Dec-Feb_in 0.6428962 0.6521671 0.3352257 0.2980816
## 6 3m_Dec-Feb_out 1.1311959 1.2004435 0.8216322 0.7622298
## 7 3m_Jan-Mar_in 0.6515307 0.6538105 0.3512270 0.3050282
## 8 3m_Jan-Mar_out 0.5595839 0.5582343 0.9358860 0.5931100
## 9 3m_Feb-Apr_in 0.6625364 0.6674092 0.3611149 0.3094236
## 10 3m_Feb-Apr_out 0.5546310 0.5695227 0.2145234 0.2689125
## 11 1m_Nov_in 0.6473017 0.6530131 0.3412081 0.3028179
## 12 1m_Nov_out 0.4941932 0.4954742 0.4818548 0.4579445
## 13 1m_Dec_in 0.6428962 0.6521671 0.3352257 0.2980816
## 14 1m_Dec_out 1.1402568 1.1848696 1.0512742 0.9927841
## 15 1m_Jan_in 0.6515307 0.6538105 0.3512270 0.3050282
## 16 1m_Jan_out 0.7364310 0.7317912 0.9687336 0.5470016
## 17 1m_Feb_in 0.6856247 0.6674092 0.3611149 0.3106785
## 18 1m_Feb_out 0.6715170 0.5613361 0.1660205 0.1947078
## 19 1m_Mar_in 0.6603712 0.6656321 0.3539051 0.3023790
## 20 1m_Mar_out 0.5349947 0.5384868 0.1909887 0.2088241
## 21 1m_Apr_in 0.6597906 0.6658463 0.3482126 0.2990208
## 22 1m_Apr_out 0.6605126 0.6709377 0.3355028 0.2833986
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 2.42185488485271 2.40517140567444 2.15285208085992
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 2.50317495996648 2.51071420616879 2.2589643205019
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 2.94324218994747 3.05021113893062 1.99035089593933
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 3.15345143621606 3.17147789239688 4.53390757349255
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 2.24432329807167 2.23019396058413 1.03777373155899
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 2.48065023694255 2.46817641736297 2.40426284125621
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 2.62607600778802 2.69244325136226 2.02984596452465
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 2.84137377443743 2.84704398921894 3.81930887153841
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.676353494652262 0.620905457428594 0.220154760923705
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 2.52150109191934 2.50090002175195 1.15279466596787
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 1.72815186029591 1.73028354206183 1.16983687695675
## hw_mul
## 1 NaN
## 2 2.46130027007225
## 3 NaN
## 4 2.43313398617843
## 5 NaN
## 6 1.87222417169747
## 7 NaN
## 8 3.7941741061251
## 9 NaN
## 10 1.60885381507066
## 11 NaN
## 12 2.70959288322267
## 13 NaN
## 14 1.91388482490275
## 15 NaN
## 16 3.09118460927018
## 17 NaN
## 18 0.318561626986709
## 19 NaN
## 20 1.34366115083376
## 21 NaN
## 22 1.101865510774
fc_result_across(2)
## $MAE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 38.77455 38.77184 21.18071 20.90222
## 2 6m_Nov-Apr_out 45.49341 45.18002 40.44032 46.23437
## 3 3m_Nov-Jan_in 38.77455 38.77184 21.18071 20.90222
## 4 3m_Nov-Jan_out 47.99566 48.14022 43.31319 46.65270
## 5 3m_Dec-Feb_in 39.16804 39.15002 21.04567 20.98880
## 6 3m_Dec-Feb_out 50.00241 51.81970 33.81385 31.80701
## 7 3m_Jan-Mar_in 39.39255 39.39627 21.49253 21.03735
## 8 3m_Jan-Mar_out 50.20995 50.49698 72.18988 60.41168
## 9 3m_Feb-Apr_in 39.80263 39.80379 21.73913 20.74706
## 10 3m_Feb-Apr_out 41.25520 40.99548 19.07638 29.57399
## 11 1m_Nov_in 38.77455 38.77184 21.18071 20.90222
## 12 1m_Nov_out 51.26677 51.00898 49.68810 55.99825
## 13 1m_Dec_in 39.16804 39.15002 21.04567 20.98880
## 14 1m_Dec_out 53.11451 54.45684 41.05527 38.70986
## 15 1m_Jan_in 39.39255 39.39627 21.49253 21.03735
## 16 1m_Jan_out 47.38678 47.48135 63.69622 51.55298
## 17 1m_Feb_in 37.75368 39.80379 21.73913 20.82137
## 18 1m_Feb_out 41.83729 38.40744 13.61814 19.70531
## 19 1m_Mar_in 39.82918 39.83565 21.39390 20.43778
## 20 1m_Mar_out 43.19087 42.83800 19.74626 23.01562
## 21 1m_Apr_in 40.01951 40.02174 21.21729 20.25453
## 22 1m_Apr_out 41.47564 41.52681 28.07609 26.44477
##
## $MAPE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 0.6473017 0.6530131 0.3412081 0.3028179
## 2 6m_Nov-Apr_out 0.6153640 0.6353902 0.5024606 0.4668452
## 3 3m_Nov-Jan_in 0.6473017 0.6530131 0.3412081 0.3028179
## 4 3m_Nov-Jan_out 0.7401124 0.7608638 0.5902200 0.5149623
## 5 3m_Dec-Feb_in 0.6428962 0.6521671 0.3352257 0.2980816
## 6 3m_Dec-Feb_out 1.1311959 1.2004435 0.8216322 0.7622298
## 7 3m_Jan-Mar_in 0.6515307 0.6538105 0.3512270 0.3050282
## 8 3m_Jan-Mar_out 0.5595839 0.5582343 0.9358860 0.5931100
## 9 3m_Feb-Apr_in 0.6625364 0.6674092 0.3611149 0.3094236
## 10 3m_Feb-Apr_out 0.5546310 0.5695227 0.2145234 0.2689125
## 11 1m_Nov_in 0.6473017 0.6530131 0.3412081 0.3028179
## 12 1m_Nov_out 0.4941932 0.4954742 0.4818548 0.4579445
## 13 1m_Dec_in 0.6428962 0.6521671 0.3352257 0.2980816
## 14 1m_Dec_out 1.1402568 1.1848696 1.0512742 0.9927841
## 15 1m_Jan_in 0.6515307 0.6538105 0.3512270 0.3050282
## 16 1m_Jan_out 0.7364310 0.7317912 0.9687336 0.5470016
## 17 1m_Feb_in 0.6856247 0.6674092 0.3611149 0.3106785
## 18 1m_Feb_out 0.6715170 0.5613361 0.1660205 0.1947078
## 19 1m_Mar_in 0.6603712 0.6656321 0.3539051 0.3023790
## 20 1m_Mar_out 0.5349947 0.5384868 0.1909887 0.2088241
## 21 1m_Apr_in 0.6597906 0.6658463 0.3482126 0.2990208
## 22 1m_Apr_out 0.6605126 0.6709377 0.3355028 0.2833986
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 2.42185488485271 2.40517140567444 2.15285208085992
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 2.50317495996648 2.51071420616879 2.2589643205019
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 2.94324218994747 3.05021113893062 1.99035089593933
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 3.15345143621606 3.17147789239688 4.53390757349255
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 2.24432329807167 2.23019396058413 1.03777373155899
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 2.48065023694255 2.46817641736297 2.40426284125621
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 2.62607600778802 2.69244325136226 2.02984596452465
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 2.84137377443743 2.84704398921894 3.81930887153841
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.676353494652262 0.620905457428594 0.220154760923705
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 2.52150109191934 2.50090002175195 1.15279466596787
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 1.72815186029591 1.73028354206183 1.16983687695675
## hw_mul
## 1 NaN
## 2 2.46130027007225
## 3 NaN
## 4 2.43313398617843
## 5 NaN
## 6 1.87222417169747
## 7 NaN
## 8 3.7941741061251
## 9 NaN
## 10 1.60885381507066
## 11 NaN
## 12 2.70959288322267
## 13 NaN
## 14 1.91388482490275
## 15 NaN
## 16 3.09118460927018
## 17 NaN
## 18 0.318561626986709
## 19 NaN
## 20 1.34366115083376
## 21 NaN
## 22 1.101865510774
es_M_MAE <- data.frame(fc_result_across(2)[1])
es_M_MAPE<- data.frame(fc_result_across(2)[2])
es_M_MASE<- data.frame(fc_result_across(2)[3]) %>% filter(row_number()%%2 ==0)
es_M_MASE<-txtRound(es_M_MASE[,-1],2)
es_M_MASE <- data.frame(forecast_period=fc_timestamp_out,es_M_MASE)
htmlTable(es_M_MASE)
| forecast_period | MASE.ses | MASE.holt | MASE.hw_add | MASE.hw_mul | |
|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 2.42 | 2.41 | 2.15 | 2.46 |
| 2 | 3m_Nov-Jan_out | 2.50 | 2.51 | 2.26 | 2.43 |
| 3 | 3m_Dec-Feb_out | 2.94 | 3.05 | 1.99 | 1.87 |
| 4 | 3m_Jan-Mar_out | 3.15 | 3.17 | 4.53 | 3.79 |
| 5 | 3m_Feb-Apr_out | 2.24 | 2.23 | 1.04 | 1.61 |
| 6 | 1m_Nov_out | 2.48 | 2.47 | 2.40 | 2.71 |
| 7 | 1m_Dec_out | 2.63 | 2.69 | 2.03 | 1.91 |
| 8 | 1m_Jan_out | 2.84 | 2.85 | 3.82 | 3.09 |
| 9 | 1m_Feb_out | 0.68 | 0.62 | 0.22 | 0.32 |
| 10 | 1m_Mar_out | 2.52 | 2.50 | 1.15 | 1.34 |
| 11 | 1m_Apr_out | 1.73 | 1.73 | 1.17 | 1.10 |
Observations
fc_result(3)
## $naive
## forecast_period MAE MAPE
## 1 6m_Nov-Apr_in 21.16216 33.42249
## 2 6m_Nov-Apr_out 22.19337 51.94556
## 3 3m_Nov-Jan_in 21.16216 33.42249
## 4 3m_Nov-Jan_out 23.32609 60.52735
## 5 3m_Dec-Feb_in 21.95814 35.56006
## 6 3m_Dec-Feb_out 18.98889 53.19512
## 7 3m_Jan-Mar_in 22.45528 41.15430
## 8 3m_Jan-Mar_out 16.24444 35.18347
## 9 3m_Feb-Apr_in 21.88087 42.42482
## 10 3m_Feb-Apr_out 21.02247 43.07450
## 11 1m_Nov_in 21.16216 33.42249
## 12 1m_Nov_out 26.86667 48.74176
## 13 1m_Dec_in 21.95814 35.56006
## 14 1m_Dec_out 25.90323 79.95303
## 15 1m_Jan_in 22.45528 41.15430
## 16 1m_Jan_out 17.32258 52.50706
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 47.03571 93.55047
## 19 1m_Mar_in 21.08197 40.76385
## 20 1m_Mar_out 17.93548 27.66112
## 21 1m_Apr_in 20.79167 39.55497
## 22 1m_Apr_out 31.53333 76.49458
##
## $ses
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 28.82098 0.5909103 NaN
## 2 6m_Nov-Apr_out 29.13186 0.9553429 1.3126381075586
## 3 3m_Nov-Jan_in 28.82098 0.5909103 NaN
## 4 3m_Nov-Jan_out 33.14034 1.2042130 1.42074162101984
## 5 3m_Dec-Feb_in 28.91952 0.6010551 NaN
## 6 3m_Dec-Feb_out 30.47796 1.0926923 1.60504186201305
## 7 3m_Jan-Mar_in 28.77723 0.6208548 NaN
## 8 3m_Jan-Mar_out 28.96293 0.5738793 1.78294381881824
## 9 3m_Feb-Apr_in 28.64621 0.6265531 NaN
## 10 3m_Feb-Apr_out 27.11680 0.5314595 1.2898960615447
## 11 1m_Nov_in 28.82098 0.5909103 NaN
## 12 1m_Nov_out 30.12265 0.7882818 1.12119051317152
## 13 1m_Dec_in 28.91952 0.6010551 NaN
## 14 1m_Dec_out 31.30868 1.2925213 1.20867897915411
## 15 1m_Jan_in 28.77723 0.6208548 NaN
## 16 1m_Jan_out 26.23703 0.7778604 1.51461459948899
## 17 1m_Feb_in 28.89159 0.5640120 NaN
## 18 1m_Feb_out 25.39501 0.4730915 0.539909198327349
## 19 1m_Mar_in 28.55806 0.6216608 NaN
## 20 1m_Mar_out 23.27438 0.4550559 1.29767225528038
## 21 1m_Apr_in 28.29187 0.6148704 NaN
## 22 1m_Apr_out 27.20959 0.9348579 0.862883557035178
##
## $holt
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 28.79836 0.5821914 NaN
## 2 6m_Nov-Apr_out 28.22814 0.8959336 1.27191747493191
## 3 3m_Nov-Jan_in 28.79836 0.5821914 NaN
## 4 3m_Nov-Jan_out 31.89648 1.1336424 1.36741660311895
## 5 3m_Dec-Feb_in 28.90371 0.5917624 NaN
## 6 3m_Dec-Feb_out 29.87686 1.0544110 1.57338646187902
## 7 3m_Jan-Mar_in 28.70823 0.6078258 NaN
## 8 3m_Jan-Mar_out 31.91232 0.5461635 1.96450677908921
## 9 3m_Feb-Apr_in 28.54008 0.6119436 NaN
## 10 3m_Feb-Apr_out 27.87490 0.5255231 1.32595706973114
## 11 1m_Nov_in 28.79836 0.5821914 NaN
## 12 1m_Nov_out 29.93947 0.7553887 1.11437240413335
## 13 1m_Dec_in 28.90371 0.5917624 NaN
## 14 1m_Dec_out 30.63154 1.2530115 1.18253756938824
## 15 1m_Jan_in 28.70823 0.6078258 NaN
## 16 1m_Jan_out 25.05556 0.6536619 1.4464104266271
## 17 1m_Feb_in 28.54008 0.6119436 NaN
## 18 1m_Feb_out 27.76141 0.4712047 0.590219869373757
## 19 1m_Mar_in 28.45956 0.6096108 NaN
## 20 1m_Mar_out 23.27199 0.4559024 1.29753915255108
## 21 1m_Apr_in 28.20198 0.6046627 NaN
## 22 1m_Apr_out 27.45437 0.9482544 0.870646128538007
##
## $hw_add
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 19.16986 0.3505977 NaN
## 2 6m_Nov-Apr_out 20.94382 0.5997629 0.943697112193449
## 3 3m_Nov-Jan_in 19.16986 0.3505977 NaN
## 4 3m_Nov-Jan_out 23.93825 0.8104840 1.02624367542471
## 5 3m_Dec-Feb_in 19.09842 0.3515533 NaN
## 6 3m_Dec-Feb_out 23.55038 0.8333053 1.24021917817597
## 7 3m_Jan-Mar_in 19.31966 0.3814761 NaN
## 8 3m_Jan-Mar_out 30.96454 0.5191572 1.90616194938938
## 9 3m_Feb-Apr_in 19.02623 0.3763300 NaN
## 10 3m_Feb-Apr_out 17.72514 0.3558995 0.843151851359788
## 11 1m_Nov_in 19.16986 0.3505977 NaN
## 12 1m_Nov_out 19.17861 0.3820458 0.71384406279644
## 13 1m_Dec_in 19.09842 0.3515533 NaN
## 14 1m_Dec_out 30.23650 1.2707635 1.16728704340749
## 15 1m_Jan_in 19.31966 0.3814761 NaN
## 16 1m_Jan_out 21.53150 0.4571971 1.24297305019322
## 17 1m_Feb_in 19.02623 0.3763300 NaN
## 18 1m_Feb_out 16.25180 0.2449163 0.34552033919289
## 19 1m_Mar_in 19.04268 0.3745319 NaN
## 20 1m_Mar_out 15.59887 0.2468240 0.869721349584206
## 21 1m_Apr_in 18.85216 0.3689643 NaN
## 22 1m_Apr_out 17.78947 0.6148652 0.564148231682622
##
## $hw_mul
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 19.36768 0.3553212 NaN
## 2 6m_Nov-Apr_out 21.78586 0.6848645 0.981638060456886
## 3 3m_Nov-Jan_in 19.36768 0.3553212 NaN
## 4 3m_Nov-Jan_out 25.33373 0.9187168 1.08606865222246
## 5 3m_Dec-Feb_in 19.28285 0.3578109 NaN
## 6 3m_Dec-Feb_out 23.37988 0.8281398 1.23123977404581
## 7 3m_Jan-Mar_in 19.52529 0.3877467 NaN
## 8 3m_Jan-Mar_out 24.38654 0.4169745 1.50122333299401
## 9 3m_Feb-Apr_in 19.36195 0.3857044 NaN
## 10 3m_Feb-Apr_out 19.19334 0.3592458 0.912991470803143
## 11 1m_Nov_in 19.36768 0.3553212 NaN
## 12 1m_Nov_out 18.43681 0.4285194 0.686233451964408
## 13 1m_Dec_in 19.28285 0.3578109 NaN
## 14 1m_Dec_out 30.10730 1.2717348 1.16229916161656
## 15 1m_Jan_in 19.52529 0.3877467 NaN
## 16 1m_Jan_out 19.87277 0.4746228 1.14721773195554
## 17 1m_Feb_in 19.35917 0.3856014 NaN
## 18 1m_Feb_out 17.38830 0.2507572 0.369682990947948
## 19 1m_Mar_in 19.30929 0.3815645 NaN
## 20 1m_Mar_out 15.90344 0.2447211 0.88670257462673
## 21 1m_Apr_in 19.13959 0.3752048 NaN
## 22 1m_Apr_out 17.83321 0.6452088 0.565535116533899
fc_result_across(3)
## $MAE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 28.82098 28.79836 19.16986 19.36768
## 2 6m_Nov-Apr_out 29.13186 28.22814 20.94382 21.78586
## 3 3m_Nov-Jan_in 28.82098 28.79836 19.16986 19.36768
## 4 3m_Nov-Jan_out 33.14034 31.89648 23.93825 25.33373
## 5 3m_Dec-Feb_in 28.91952 28.90371 19.09842 19.28285
## 6 3m_Dec-Feb_out 30.47796 29.87686 23.55038 23.37988
## 7 3m_Jan-Mar_in 28.77723 28.70823 19.31966 19.52529
## 8 3m_Jan-Mar_out 28.96293 31.91232 30.96454 24.38654
## 9 3m_Feb-Apr_in 28.64621 28.54008 19.02623 19.36195
## 10 3m_Feb-Apr_out 27.11680 27.87490 17.72514 19.19334
## 11 1m_Nov_in 28.82098 28.79836 19.16986 19.36768
## 12 1m_Nov_out 30.12265 29.93947 19.17861 18.43681
## 13 1m_Dec_in 28.91952 28.90371 19.09842 19.28285
## 14 1m_Dec_out 31.30868 30.63154 30.23650 30.10730
## 15 1m_Jan_in 28.77723 28.70823 19.31966 19.52529
## 16 1m_Jan_out 26.23703 25.05556 21.53150 19.87277
## 17 1m_Feb_in 28.89159 28.54008 19.02623 19.35917
## 18 1m_Feb_out 25.39501 27.76141 16.25180 17.38830
## 19 1m_Mar_in 28.55806 28.45956 19.04268 19.30929
## 20 1m_Mar_out 23.27438 23.27199 15.59887 15.90344
## 21 1m_Apr_in 28.29187 28.20198 18.85216 19.13959
## 22 1m_Apr_out 27.20959 27.45437 17.78947 17.83321
##
## $MAPE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 0.5909103 0.5821914 0.3505977 0.3553212
## 2 6m_Nov-Apr_out 0.9553429 0.8959336 0.5997629 0.6848645
## 3 3m_Nov-Jan_in 0.5909103 0.5821914 0.3505977 0.3553212
## 4 3m_Nov-Jan_out 1.2042130 1.1336424 0.8104840 0.9187168
## 5 3m_Dec-Feb_in 0.6010551 0.5917624 0.3515533 0.3578109
## 6 3m_Dec-Feb_out 1.0926923 1.0544110 0.8333053 0.8281398
## 7 3m_Jan-Mar_in 0.6208548 0.6078258 0.3814761 0.3877467
## 8 3m_Jan-Mar_out 0.5738793 0.5461635 0.5191572 0.4169745
## 9 3m_Feb-Apr_in 0.6265531 0.6119436 0.3763300 0.3857044
## 10 3m_Feb-Apr_out 0.5314595 0.5255231 0.3558995 0.3592458
## 11 1m_Nov_in 0.5909103 0.5821914 0.3505977 0.3553212
## 12 1m_Nov_out 0.7882818 0.7553887 0.3820458 0.4285194
## 13 1m_Dec_in 0.6010551 0.5917624 0.3515533 0.3578109
## 14 1m_Dec_out 1.2925213 1.2530115 1.2707635 1.2717348
## 15 1m_Jan_in 0.6208548 0.6078258 0.3814761 0.3877467
## 16 1m_Jan_out 0.7778604 0.6536619 0.4571971 0.4746228
## 17 1m_Feb_in 0.5640120 0.6119436 0.3763300 0.3856014
## 18 1m_Feb_out 0.4730915 0.4712047 0.2449163 0.2507572
## 19 1m_Mar_in 0.6216608 0.6096108 0.3745319 0.3815645
## 20 1m_Mar_out 0.4550559 0.4559024 0.2468240 0.2447211
## 21 1m_Apr_in 0.6148704 0.6046627 0.3689643 0.3752048
## 22 1m_Apr_out 0.9348579 0.9482544 0.6148652 0.6452088
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 1.3126381075586 1.27191747493191 0.943697112193449
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 1.42074162101984 1.36741660311895 1.02624367542471
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 1.60504186201305 1.57338646187902 1.24021917817597
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 1.78294381881824 1.96450677908921 1.90616194938938
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 1.2898960615447 1.32595706973114 0.843151851359788
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 1.12119051317152 1.11437240413335 0.71384406279644
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 1.20867897915411 1.18253756938824 1.16728704340749
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 1.51461459948899 1.4464104266271 1.24297305019322
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.539909198327349 0.590219869373757 0.34552033919289
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 1.29767225528038 1.29753915255108 0.869721349584206
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 0.862883557035178 0.870646128538007 0.564148231682622
## hw_mul
## 1 NaN
## 2 0.981638060456886
## 3 NaN
## 4 1.08606865222246
## 5 NaN
## 6 1.23123977404581
## 7 NaN
## 8 1.50122333299401
## 9 NaN
## 10 0.912991470803143
## 11 NaN
## 12 0.686233451964408
## 13 NaN
## 14 1.16229916161656
## 15 NaN
## 16 1.14721773195554
## 17 NaN
## 18 0.369682990947948
## 19 NaN
## 20 0.88670257462673
## 21 NaN
## 22 0.565535116533899
fc_timestamp_out_order<-c("1m_Nov_out","1m_Dec_out","1m_Jan_out","1m_Feb_out","1m_Mar_out","1m_Apr_out","3m_Nov-Jan_out","3m_Dec-Feb_out","3m_Jan-Mar_out","3m_Feb-Apr_out","6m_Nov-Apr_out")
fc_result_across(3)
## $MAE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 28.82098 28.79836 19.16986 19.36768
## 2 6m_Nov-Apr_out 29.13186 28.22814 20.94382 21.78586
## 3 3m_Nov-Jan_in 28.82098 28.79836 19.16986 19.36768
## 4 3m_Nov-Jan_out 33.14034 31.89648 23.93825 25.33373
## 5 3m_Dec-Feb_in 28.91952 28.90371 19.09842 19.28285
## 6 3m_Dec-Feb_out 30.47796 29.87686 23.55038 23.37988
## 7 3m_Jan-Mar_in 28.77723 28.70823 19.31966 19.52529
## 8 3m_Jan-Mar_out 28.96293 31.91232 30.96454 24.38654
## 9 3m_Feb-Apr_in 28.64621 28.54008 19.02623 19.36195
## 10 3m_Feb-Apr_out 27.11680 27.87490 17.72514 19.19334
## 11 1m_Nov_in 28.82098 28.79836 19.16986 19.36768
## 12 1m_Nov_out 30.12265 29.93947 19.17861 18.43681
## 13 1m_Dec_in 28.91952 28.90371 19.09842 19.28285
## 14 1m_Dec_out 31.30868 30.63154 30.23650 30.10730
## 15 1m_Jan_in 28.77723 28.70823 19.31966 19.52529
## 16 1m_Jan_out 26.23703 25.05556 21.53150 19.87277
## 17 1m_Feb_in 28.89159 28.54008 19.02623 19.35917
## 18 1m_Feb_out 25.39501 27.76141 16.25180 17.38830
## 19 1m_Mar_in 28.55806 28.45956 19.04268 19.30929
## 20 1m_Mar_out 23.27438 23.27199 15.59887 15.90344
## 21 1m_Apr_in 28.29187 28.20198 18.85216 19.13959
## 22 1m_Apr_out 27.20959 27.45437 17.78947 17.83321
##
## $MAPE
## forecast_period ses holt hw_add hw_mul
## 1 6m_Nov-Apr_in 0.5909103 0.5821914 0.3505977 0.3553212
## 2 6m_Nov-Apr_out 0.9553429 0.8959336 0.5997629 0.6848645
## 3 3m_Nov-Jan_in 0.5909103 0.5821914 0.3505977 0.3553212
## 4 3m_Nov-Jan_out 1.2042130 1.1336424 0.8104840 0.9187168
## 5 3m_Dec-Feb_in 0.6010551 0.5917624 0.3515533 0.3578109
## 6 3m_Dec-Feb_out 1.0926923 1.0544110 0.8333053 0.8281398
## 7 3m_Jan-Mar_in 0.6208548 0.6078258 0.3814761 0.3877467
## 8 3m_Jan-Mar_out 0.5738793 0.5461635 0.5191572 0.4169745
## 9 3m_Feb-Apr_in 0.6265531 0.6119436 0.3763300 0.3857044
## 10 3m_Feb-Apr_out 0.5314595 0.5255231 0.3558995 0.3592458
## 11 1m_Nov_in 0.5909103 0.5821914 0.3505977 0.3553212
## 12 1m_Nov_out 0.7882818 0.7553887 0.3820458 0.4285194
## 13 1m_Dec_in 0.6010551 0.5917624 0.3515533 0.3578109
## 14 1m_Dec_out 1.2925213 1.2530115 1.2707635 1.2717348
## 15 1m_Jan_in 0.6208548 0.6078258 0.3814761 0.3877467
## 16 1m_Jan_out 0.7778604 0.6536619 0.4571971 0.4746228
## 17 1m_Feb_in 0.5640120 0.6119436 0.3763300 0.3856014
## 18 1m_Feb_out 0.4730915 0.4712047 0.2449163 0.2507572
## 19 1m_Mar_in 0.6216608 0.6096108 0.3745319 0.3815645
## 20 1m_Mar_out 0.4550559 0.4559024 0.2468240 0.2447211
## 21 1m_Apr_in 0.6148704 0.6046627 0.3689643 0.3752048
## 22 1m_Apr_out 0.9348579 0.9482544 0.6148652 0.6452088
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 1.3126381075586 1.27191747493191 0.943697112193449
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 1.42074162101984 1.36741660311895 1.02624367542471
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 1.60504186201305 1.57338646187902 1.24021917817597
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 1.78294381881824 1.96450677908921 1.90616194938938
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 1.2898960615447 1.32595706973114 0.843151851359788
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 1.12119051317152 1.11437240413335 0.71384406279644
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 1.20867897915411 1.18253756938824 1.16728704340749
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 1.51461459948899 1.4464104266271 1.24297305019322
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.539909198327349 0.590219869373757 0.34552033919289
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 1.29767225528038 1.29753915255108 0.869721349584206
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 0.862883557035178 0.870646128538007 0.564148231682622
## hw_mul
## 1 NaN
## 2 0.981638060456886
## 3 NaN
## 4 1.08606865222246
## 5 NaN
## 6 1.23123977404581
## 7 NaN
## 8 1.50122333299401
## 9 NaN
## 10 0.912991470803143
## 11 NaN
## 12 0.686233451964408
## 13 NaN
## 14 1.16229916161656
## 15 NaN
## 16 1.14721773195554
## 17 NaN
## 18 0.369682990947948
## 19 NaN
## 20 0.88670257462673
## 21 NaN
## 22 0.565535116533899
es_W_MAE <- data.frame(fc_result_across(3)[1])
es_W_MAPE<- data.frame(fc_result_across(3)[2])
es_W_MASE<- data.frame(fc_result_across(3)[3]) %>% filter(row_number()%%2 ==0)
es_W_MASE<-txtRound(es_W_MASE[,-1],2)
es_W_MASE <- data.frame(forecast_period=fc_timestamp_out,es_W_MASE)
htmlTable(es_W_MASE)
| forecast_period | MASE.ses | MASE.holt | MASE.hw_add | MASE.hw_mul | |
|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 1.31 | 1.27 | 0.94 | 0.98 |
| 2 | 3m_Nov-Jan_out | 1.42 | 1.37 | 1.03 | 1.09 |
| 3 | 3m_Dec-Feb_out | 1.61 | 1.57 | 1.24 | 1.23 |
| 4 | 3m_Jan-Mar_out | 1.78 | 1.96 | 1.91 | 1.50 |
| 5 | 3m_Feb-Apr_out | 1.29 | 1.33 | 0.84 | 0.91 |
| 6 | 1m_Nov_out | 1.12 | 1.11 | 0.71 | 0.69 |
| 7 | 1m_Dec_out | 1.21 | 1.18 | 1.17 | 1.16 |
| 8 | 1m_Jan_out | 1.51 | 1.45 | 1.24 | 1.15 |
| 9 | 1m_Feb_out | 0.54 | 0.59 | 0.35 | 0.37 |
| 10 | 1m_Mar_out | 1.30 | 1.30 | 0.87 | 0.89 |
| 11 | 1m_Apr_out | 0.86 | 0.87 | 0.56 | 0.57 |
Observations
Generally, the holt Winters model with additive and multive seasonality method did better job then the ses and holt model.
Holt Winter is the best model for hotel WARUK with only 3 forecasts that are greater than 1 which is worse than naive forecast
the one forecast demand for 2010 Dec and Jan have the lowest MASE
this model yields comparable results to additive method
ses_alpha <- function(hotel_no) {
## six-month forecasting errors
six_month_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30")
## three-month forecasting errors
three_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31")
three_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28")
three_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31")
three_month_4_ses <-fc_ses("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30")
## one-month forecasting errors
one_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30")
one_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31")
one_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31")
one_month_4_ses <-fc_ses("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28")
one_month_5_ses <-fc_ses("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31")
one_month_6_ses <-fc_ses("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30")
ses_alpha<-rbind(round(six_month_ses$model$par[1],3),round(three_month_1_ses$model$par[1],3),round(three_month_2_ses$model$par[1],3),round(three_month_3_ses$model$par[1],3),round(three_month_4_ses$model$par[1],3),round(one_month_1_ses$model$par[1],3),round(one_month_2_ses$model$par[1],3),round(one_month_3_ses$model$par[1],3),round(one_month_4_ses$model$par[1],3),round(one_month_5_ses$model$par[1],3),round(one_month_6_ses$model$par[1],3))
return(ses_alpha)
}
ses_alpha(1)
## alpha
## [1,] 0.188
## [2,] 0.188
## [3,] 0.184
## [4,] 0.199
## [5,] 0.211
## [6,] 0.188
## [7,] 0.184
## [8,] 0.199
## [9,] 0.253
## [10,] 0.213
## [11,] 0.206
ses_alpha(2)
## alpha
## [1,] 0.086
## [2,] 0.086
## [3,] 0.084
## [4,] 0.107
## [5,] 0.108
## [6,] 0.086
## [7,] 0.084
## [8,] 0.107
## [9,] 0.132
## [10,] 0.103
## [11,] 0.096
ses_alpha(3)
## alpha
## [1,] 0.044
## [2,] 0.044
## [3,] 0.043
## [4,] 0.052
## [5,] 0.053
## [6,] 0.044
## [7,] 0.043
## [8,] 0.052
## [9,] 0.053
## [10,] 0.054
## [11,] 0.054
ses_alpha_3.df<- data.frame(alpha_G =ses_alpha(1)[,1], alpha_M =ses_alpha(2)[,1],alpha_W=ses_alpha(3)[,1])
ses_alpha_3 <-data.frame(forecast_period = fc_timestamp_out, ses_alpha_3.df)
htmlTable(ses_alpha_3)
| forecast_period | alpha_G | alpha_M | alpha_W | |
|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 0.188 | 0.086 | 0.044 |
| 2 | 3m_Nov-Jan_out | 0.188 | 0.086 | 0.044 |
| 3 | 3m_Dec-Feb_out | 0.184 | 0.084 | 0.043 |
| 4 | 3m_Jan-Mar_out | 0.199 | 0.107 | 0.052 |
| 5 | 3m_Feb-Apr_out | 0.211 | 0.108 | 0.053 |
| 6 | 1m_Nov_out | 0.188 | 0.086 | 0.044 |
| 7 | 1m_Dec_out | 0.184 | 0.084 | 0.043 |
| 8 | 1m_Jan_out | 0.199 | 0.107 | 0.052 |
| 9 | 1m_Feb_out | 0.253 | 0.132 | 0.053 |
| 10 | 1m_Mar_out | 0.213 | 0.103 | 0.054 |
| 11 | 1m_Apr_out | 0.206 | 0.096 | 0.054 |
holt_alphabeta<- function(hotel_no) {
## six-month forecasting errors
six_month_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30")
## three-month forecasting errors
three_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31")
three_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28")
three_month_3_holt <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31")
three_month_4_holt <-fc_holt("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30")
## one-month forecasting errors
one_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30")
one_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31")
one_month_3_holt <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31")
one_month_4_holt <-fc_holt("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28")
one_month_5_holt <-fc_holt("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31")
one_month_6_holt <-fc_holt("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30")
holt_alphabeta<-rbind(round(six_month_holt$model$par[1:2],4),round(three_month_1_holt$model$par[1:2],4),round(three_month_2_holt$model$par[1:2],4),round(three_month_3_holt$model$par[1:2],4),round(three_month_4_holt$model$par[1:2],4),round(one_month_1_holt$model$par[1:2],4),round(one_month_2_holt$model$par[1:2],4),round(one_month_3_holt$model$par[1:2],4),round(one_month_4_holt$model$par[1:2],4),round(one_month_5_holt$model$par[1:2],4),round(one_month_6_holt$model$par[1:2],4))
return(holt_alphabeta)
}
holt_alphabeta(1)
## alpha beta
## [1,] 0.1921 1e-04
## [2,] 0.1921 1e-04
## [3,] 0.1882 1e-04
## [4,] 0.2024 1e-04
## [5,] 0.2142 1e-04
## [6,] 0.1921 1e-04
## [7,] 0.1882 1e-04
## [8,] 0.2024 1e-04
## [9,] 0.2572 1e-04
## [10,] 0.2158 1e-04
## [11,] 0.2084 1e-04
holt_alphabeta(2)
## alpha beta
## [1,] 0.0881 1e-04
## [2,] 0.0881 1e-04
## [3,] 0.0844 1e-04
## [4,] 0.1093 1e-04
## [5,] 0.1104 1e-04
## [6,] 0.0881 1e-04
## [7,] 0.0844 1e-04
## [8,] 0.1093 1e-04
## [9,] 0.1328 1e-04
## [10,] 0.1052 1e-04
## [11,] 0.0982 1e-04
holt_alphabeta(3)
## alpha beta
## [1,] 0.0634 1e-04
## [2,] 0.0634 1e-04
## [3,] 0.0612 1e-04
## [4,] 0.0681 1e-04
## [5,] 0.0685 1e-04
## [6,] 0.0634 1e-04
## [7,] 0.0612 1e-04
## [8,] 0.0681 1e-04
## [9,] 0.0815 1e-04
## [10,] 0.0699 1e-04
## [11,] 0.0691 1e-04
holt_alphabeta_3.df <- data.frame(alpha__G =holt_alphabeta(1)[,1], beta__G =holt_alphabeta(1)[,2],alpha_M =holt_alphabeta(2)[,1],beta_M =holt_alphabeta(2)[,2],alpha_W=holt_alphabeta(3)[,1],beta_W=holt_alphabeta(3)[,2])
holt_alphabeta_3 <-data.frame(forecast_period = fc_timestamp_out, holt_alphabeta_3.df)
htmlTable(holt_alphabeta_3 )
| forecast_period | alpha__G | beta__G | alpha_M | beta_M | alpha_W | beta_W | |
|---|---|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 0.1921 | 1e-04 | 0.0881 | 1e-04 | 0.0634 | 1e-04 |
| 2 | 3m_Nov-Jan_out | 0.1921 | 1e-04 | 0.0881 | 1e-04 | 0.0634 | 1e-04 |
| 3 | 3m_Dec-Feb_out | 0.1882 | 1e-04 | 0.0844 | 1e-04 | 0.0612 | 1e-04 |
| 4 | 3m_Jan-Mar_out | 0.2024 | 1e-04 | 0.1093 | 1e-04 | 0.0681 | 1e-04 |
| 5 | 3m_Feb-Apr_out | 0.2142 | 1e-04 | 0.1104 | 1e-04 | 0.0685 | 1e-04 |
| 6 | 1m_Nov_out | 0.1921 | 1e-04 | 0.0881 | 1e-04 | 0.0634 | 1e-04 |
| 7 | 1m_Dec_out | 0.1882 | 1e-04 | 0.0844 | 1e-04 | 0.0612 | 1e-04 |
| 8 | 1m_Jan_out | 0.2024 | 1e-04 | 0.1093 | 1e-04 | 0.0681 | 1e-04 |
| 9 | 1m_Feb_out | 0.2572 | 1e-04 | 0.1328 | 1e-04 | 0.0815 | 1e-04 |
| 10 | 1m_Mar_out | 0.2158 | 1e-04 | 0.1052 | 1e-04 | 0.0699 | 1e-04 |
| 11 | 1m_Apr_out | 0.2084 | 1e-04 | 0.0982 | 1e-04 | 0.0691 | 1e-04 |
png(filename="holt_alphabeta_3.png")
hw_add_abg<- function(hotel_no) {
## six-month forecasting errors
six_month_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","additive")
## three-month forecasting errors
three_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31","additive")
three_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28","additive")
three_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31","additive")
three_month_4_hw <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30","additive")
## one-month forecasting errors
one_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30","additive")
one_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31","additive")
one_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31","additive")
one_month_4_hw <-fc_hw("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28","additive")
one_month_5_hw <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31","additive")
one_month_6_hw <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30","additive")
hw_add_abg<-rbind(round(six_month_hw$model$par[1:3],4),round(three_month_1_hw$model$par[1:3],4),round(three_month_2_hw$model$par[1:3],4),round(three_month_3_hw$model$par[1:3],4),round(three_month_4_hw$model$par[1:3],4),round(one_month_1_hw$model$par[1:3],4),round(one_month_2_hw$model$par[1:3],4),round(one_month_3_hw$model$par[1:3],4),round(one_month_4_hw$model$par[1:3],4),round(one_month_5_hw$model$par[1:3],4),round(one_month_6_hw$model$par[1:3],4))
return(hw_add_abg)
}
hw_add_abg(1)
## alpha beta gamma
## [1,] 0.4651 1e-04 1e-04
## [2,] 0.4651 1e-04 1e-04
## [3,] 0.4676 1e-04 1e-04
## [4,] 0.5012 1e-04 1e-04
## [5,] 0.4832 1e-04 2e-04
## [6,] 0.4651 1e-04 1e-04
## [7,] 0.4676 1e-04 1e-04
## [8,] 0.5012 1e-04 1e-04
## [9,] 0.5251 1e-04 1e-04
## [10,] 0.4711 1e-04 2e-04
## [11,] 0.4631 1e-04 1e-04
hw_add_abg(2)
## alpha beta gamma
## [1,] 0.4400 1e-04 1e-04
## [2,] 0.4400 1e-04 1e-04
## [3,] 0.4203 1e-04 2e-04
## [4,] 0.4626 1e-04 1e-04
## [5,] 0.4641 1e-04 1e-04
## [6,] 0.4400 1e-04 1e-04
## [7,] 0.4203 1e-04 2e-04
## [8,] 0.4626 1e-04 1e-04
## [9,] 0.4881 1e-04 2e-04
## [10,] 0.4760 1e-04 1e-04
## [11,] 0.4568 1e-04 1e-04
hw_add_abg(3)
## alpha beta gamma
## [1,] 0.0770 1e-04 0.1040
## [2,] 0.0770 1e-04 0.1040
## [3,] 0.0674 1e-04 0.1352
## [4,] 0.0868 1e-04 0.1379
## [5,] 0.0995 1e-04 0.1485
## [6,] 0.0770 1e-04 0.1040
## [7,] 0.0674 1e-04 0.1352
## [8,] 0.0868 1e-04 0.1379
## [9,] 0.1430 1e-04 0.0004
## [10,] 0.0962 1e-04 0.1388
## [11,] 0.0970 1e-04 0.1334
hw_add_abg_3.df <- data.frame(alpha_G =hw_add_abg(1)[,1], beta_G =hw_add_abg(1)[,2],gamma_G =hw_add_abg(1)[,3],alpha_M =hw_add_abg(2)[,1],beta_M =hw_add_abg(2)[,2],gamma_M =hw_add_abg(2)[,3],alpha_W=hw_add_abg(3)[,1],beta_W=hw_add_abg(3)[,2],gamma_W=hw_add_abg(3)[,3])
hw_add_abg_3 <-data.frame(forecast_period = fc_timestamp_out, hw_add_abg_3.df)
htmlTable(hw_add_abg_3)
| forecast_period | alpha_G | beta_G | gamma_G | alpha_M | beta_M | gamma_M | alpha_W | beta_W | gamma_W | |
|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 0.4651 | 1e-04 | 1e-04 | 0.44 | 1e-04 | 1e-04 | 0.077 | 1e-04 | 0.104 |
| 2 | 3m_Nov-Jan_out | 0.4651 | 1e-04 | 1e-04 | 0.44 | 1e-04 | 1e-04 | 0.077 | 1e-04 | 0.104 |
| 3 | 3m_Dec-Feb_out | 0.4676 | 1e-04 | 1e-04 | 0.4203 | 1e-04 | 2e-04 | 0.0674 | 1e-04 | 0.1352 |
| 4 | 3m_Jan-Mar_out | 0.5012 | 1e-04 | 1e-04 | 0.4626 | 1e-04 | 1e-04 | 0.0868 | 1e-04 | 0.1379 |
| 5 | 3m_Feb-Apr_out | 0.4832 | 1e-04 | 2e-04 | 0.4641 | 1e-04 | 1e-04 | 0.0995 | 1e-04 | 0.1485 |
| 6 | 1m_Nov_out | 0.4651 | 1e-04 | 1e-04 | 0.44 | 1e-04 | 1e-04 | 0.077 | 1e-04 | 0.104 |
| 7 | 1m_Dec_out | 0.4676 | 1e-04 | 1e-04 | 0.4203 | 1e-04 | 2e-04 | 0.0674 | 1e-04 | 0.1352 |
| 8 | 1m_Jan_out | 0.5012 | 1e-04 | 1e-04 | 0.4626 | 1e-04 | 1e-04 | 0.0868 | 1e-04 | 0.1379 |
| 9 | 1m_Feb_out | 0.5251 | 1e-04 | 1e-04 | 0.4881 | 1e-04 | 2e-04 | 0.143 | 1e-04 | 4e-04 |
| 10 | 1m_Mar_out | 0.4711 | 1e-04 | 2e-04 | 0.476 | 1e-04 | 1e-04 | 0.0962 | 1e-04 | 0.1388 |
| 11 | 1m_Apr_out | 0.4631 | 1e-04 | 1e-04 | 0.4568 | 1e-04 | 1e-04 | 0.097 | 1e-04 | 0.1334 |
hw_mul_abg<- function(hotel_no) {
## six-month forecasting errors
six_month_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","multiplicative")
## three-month forecasting errors
three_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31","multiplicative")
three_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28","multiplicative")
three_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31","multiplicative")
three_month_4_hw <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30","multiplicative")
## one-month forecasting errors
one_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30","multiplicative")
one_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31","multiplicative")
one_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31","multiplicative")
one_month_4_hw <-fc_hw("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28","multiplicative")
one_month_5_hw <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31","multiplicative")
one_month_6_hw <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30","multiplicative")
hw_mul_abg<-rbind(round(six_month_hw$model$par[1:3],4),round(three_month_1_hw$model$par[1:3],4),round(three_month_2_hw$model$par[1:3],4),round(three_month_3_hw$model$par[1:3],4),round(three_month_4_hw$model$par[1:3],4),round(one_month_1_hw$model$par[1:3],4),round(one_month_2_hw$model$par[1:3],4),round(one_month_3_hw$model$par[1:3],4),round(one_month_4_hw$model$par[1:3],4),round(one_month_5_hw$model$par[1:3],4),round(one_month_6_hw$model$par[1:3],4))
return(hw_mul_abg)
}
hw_mul_abg(1)
## alpha beta gamma
## [1,] 0.4008 1e-04 0.0001
## [2,] 0.4008 1e-04 0.0001
## [3,] 0.3818 1e-04 0.0001
## [4,] 0.4472 1e-04 0.0001
## [5,] 0.4455 1e-04 0.0001
## [6,] 0.4008 1e-04 0.0001
## [7,] 0.3818 1e-04 0.0001
## [8,] 0.4472 1e-04 0.0001
## [9,] 0.3814 1e-04 0.0001
## [10,] 0.4446 1e-04 0.0001
## [11,] 0.4228 1e-04 0.0054
hw_mul_abg(2)
## alpha beta gamma
## [1,] 0.5514 0.0011 0.0001
## [2,] 0.5514 0.0011 0.0001
## [3,] 0.4789 0.0001 0.0001
## [4,] 0.4457 0.0001 0.0001
## [5,] 0.5764 0.0042 0.0001
## [6,] 0.5514 0.0011 0.0001
## [7,] 0.4789 0.0001 0.0001
## [8,] 0.4457 0.0001 0.0001
## [9,] 0.5401 0.0001 0.0254
## [10,] 0.5719 0.0001 0.0001
## [11,] 0.5871 0.0010 0.0001
hw_mul_abg(3)
## alpha beta gamma
## [1,] 0.0339 1e-04 0.1513
## [2,] 0.0339 1e-04 0.1513
## [3,] 0.0298 1e-04 0.1586
## [4,] 0.0508 1e-04 0.1447
## [5,] 0.0602 1e-04 0.1517
## [6,] 0.0339 1e-04 0.1513
## [7,] 0.0298 1e-04 0.1586
## [8,] 0.0508 1e-04 0.1447
## [9,] 0.0980 1e-04 0.0432
## [10,] 0.0596 1e-04 0.1464
## [11,] 0.0591 1e-04 0.1407
hw_mul_abg_3 <- data.frame(alpha_G =hw_mul_abg(1)[,1], beta_G =hw_mul_abg(1)[,2],gamma_G =hw_mul_abg(1)[,3],alpha_M =hw_mul_abg(2)[,1],beta_M =hw_mul_abg(2)[,2],gamma_M =hw_mul_abg(2)[,3],alpha_W=hw_mul_abg(3)[,1],beta_W=hw_mul_abg(3)[,2],gamma_W=hw_mul_abg(3)[,3])
hw_mul_abg_3
## alpha_G beta_G gamma_G alpha_M beta_M gamma_M alpha_W beta_W gamma_W
## 1 0.4008 1e-04 0.0001 0.5514 0.0011 0.0001 0.0339 1e-04 0.1513
## 2 0.4008 1e-04 0.0001 0.5514 0.0011 0.0001 0.0339 1e-04 0.1513
## 3 0.3818 1e-04 0.0001 0.4789 0.0001 0.0001 0.0298 1e-04 0.1586
## 4 0.4472 1e-04 0.0001 0.4457 0.0001 0.0001 0.0508 1e-04 0.1447
## 5 0.4455 1e-04 0.0001 0.5764 0.0042 0.0001 0.0602 1e-04 0.1517
## 6 0.4008 1e-04 0.0001 0.5514 0.0011 0.0001 0.0339 1e-04 0.1513
## 7 0.3818 1e-04 0.0001 0.4789 0.0001 0.0001 0.0298 1e-04 0.1586
## 8 0.4472 1e-04 0.0001 0.4457 0.0001 0.0001 0.0508 1e-04 0.1447
## 9 0.3814 1e-04 0.0001 0.5401 0.0001 0.0254 0.0980 1e-04 0.0432
## 10 0.4446 1e-04 0.0001 0.5719 0.0001 0.0001 0.0596 1e-04 0.1464
## 11 0.4228 1e-04 0.0054 0.5871 0.0010 0.0001 0.0591 1e-04 0.1407
hw_mul_abg_3 <-data.frame(forecast_period = fc_timestamp_out, hw_mul_abg_3)
htmlTable(hw_mul_abg_3)
| forecast_period | alpha_G | beta_G | gamma_G | alpha_M | beta_M | gamma_M | alpha_W | beta_W | gamma_W | |
|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 0.4008 | 1e-04 | 1e-04 | 0.5514 | 0.0011 | 1e-04 | 0.0339 | 1e-04 | 0.1513 |
| 2 | 3m_Nov-Jan_out | 0.4008 | 1e-04 | 1e-04 | 0.5514 | 0.0011 | 1e-04 | 0.0339 | 1e-04 | 0.1513 |
| 3 | 3m_Dec-Feb_out | 0.3818 | 1e-04 | 1e-04 | 0.4789 | 1e-04 | 1e-04 | 0.0298 | 1e-04 | 0.1586 |
| 4 | 3m_Jan-Mar_out | 0.4472 | 1e-04 | 1e-04 | 0.4457 | 1e-04 | 1e-04 | 0.0508 | 1e-04 | 0.1447 |
| 5 | 3m_Feb-Apr_out | 0.4455 | 1e-04 | 1e-04 | 0.5764 | 0.0042 | 1e-04 | 0.0602 | 1e-04 | 0.1517 |
| 6 | 1m_Nov_out | 0.4008 | 1e-04 | 1e-04 | 0.5514 | 0.0011 | 1e-04 | 0.0339 | 1e-04 | 0.1513 |
| 7 | 1m_Dec_out | 0.3818 | 1e-04 | 1e-04 | 0.4789 | 1e-04 | 1e-04 | 0.0298 | 1e-04 | 0.1586 |
| 8 | 1m_Jan_out | 0.4472 | 1e-04 | 1e-04 | 0.4457 | 1e-04 | 1e-04 | 0.0508 | 1e-04 | 0.1447 |
| 9 | 1m_Feb_out | 0.3814 | 1e-04 | 1e-04 | 0.5401 | 1e-04 | 0.0254 | 0.098 | 1e-04 | 0.0432 |
| 10 | 1m_Mar_out | 0.4446 | 1e-04 | 1e-04 | 0.5719 | 1e-04 | 1e-04 | 0.0596 | 1e-04 | 0.1464 |
| 11 | 1m_Apr_out | 0.4228 | 1e-04 | 0.0054 | 0.5871 | 0.001 | 1e-04 | 0.0591 | 1e-04 | 0.1407 |
full_dataset_ts <- full_dataset %>% select(-stay_date) %>% ts(frequency = 7)
in_sample_dataset_ts <- subset(full_dataset_ts,end = 549)
out_sample_dataset_ts <- subset(full_dataset_ts,start = 550)
# create auto ARIMA model fitting function
fc_auto.arima <- function(hotel_no)
{lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
fc_ts <- auto.arima(in_sample_dataset_ts[,hotel_no],lambda =lambda)
return(fc_ts)
}
# create ARIMA model fitting function
fc_Arima <- function(hotel_no,p,d,q)
{lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
fc_ts <- Arima(in_sample_dataset_ts[,hotel_no],lambda =lambda,order = c(p,d,q))
return(fc_ts)
}
# create Seasonal ARIMA model fitting function
fc_SArima <- function(hotel_no,p,d,q,P,D,Q)
{lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
fc_ts <- Arima(in_sample_dataset_ts[,hotel_no],lambda =lambda,order = c(p,d,q),seasonal=c(P,D,Q))
return(fc_ts)
}
# create Arima forecast result function
fc_Arima_error <- function(hotel_no,p,d,q) {
# create snaive forecast function
fc_snaive <- function(time1,time2,hotel_no,time3,time4) { k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(naive_dataset_ts,end=k)
fc_ts <- snaive(training_ts[,hotel_no], h = k1) %>% accuracy(naive_dataset_ts[,hotel_no])
return(fc_ts)
}
# create ARIMA forecast function
fc_Arima <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q) { k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
training_ts <- subset(full_dataset_ts,end=k)
lambda <- BoxCox.lambda(training_ts[,hotel_no])
fc_ts <- Arima(training_ts [,hotel_no],lambda = lambda,order=c(p,d,q),method="CSS") %>% forecast(h = k1) %>% accuracy(full_dataset_ts[,hotel_no])
return(fc_ts)
}
# naive model forecast
## six-month forecasting errors
six_month <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30")
## three-month forecasting errors
three_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31")
three_month_2 <-fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28")
three_month_3 <-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2009-01-01","2010-03-31")
three_month_4 <-fc_snaive("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30")
## one-month forecasting errors
one_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30")
one_month_2<- fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31")
one_month_3<-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31")
one_month_4<-fc_snaive("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28")
one_month_5<-fc_snaive("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31")
one_month_6<-fc_snaive("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30")
# combine all the matrix
naive_result<-rbind(six_month,three_month_1,three_month_2,three_month_3,three_month_4,one_month_1,one_month_2,one_month_3,one_month_4,one_month_5,one_month_6)
# transfer to data frame and only keep test data result and MAE and MAPE
naive_result.df<- as.data.frame(naive_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2 ==1)
# rename the row name
naive_result<-data.frame(forecast_period= fc_timestamp, naive_result.df)
# Arima model forecast
## six-month forecasting errors
six_month_Arima <- fc_Arima(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30", p,d,q)
## three-month forecasting errors
three_month_1_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q)
three_month_2_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q)
three_month_3_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q)
three_month_4_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q)
## one-month forecasting errors
one_month_1_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q)
one_month_2_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q)
one_month_3_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q)
one_month_4_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q)
one_month_5_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q)
one_month_6_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q)
# combine all the matrix
arima_result <- rbind(six_month_Arima,three_month_1_Arima,three_month_2_Arima,three_month_3_Arima,three_month_4_Arima,one_month_1_Arima,one_month_2_Arima,one_month_3_Arima,one_month_4_Arima,one_month_5_Arima,one_month_6_Arima)
# transfer to data frame and only keep MAE and MAPE
arima_result.df<- as.data.frame(arima_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0|row_number()%%2==1)
# rename the row name
arima_result <- data.frame(forecast_period= fc_timestamp, arima_result.df)
# mutate MAPE as decimal number
arima_result <- arima_result %>% mutate(MAPE= MAPE/100)
# calculate MASE
arima_result <- arima_result %>%mutate(MASE = as.matrix(arima_result["MAE"])/as.matrix(naive_result["MAE"]))
# remove MASE for in-sample
arima_result <- arima_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
return(arima_result)
}
#create Sarima forecast result function
fc_SArima_error <- function(hotel_no,p,d,q,P,D,Q) {
# create snaive forecast function
fc_snaive <- function(time1,time2,hotel_no,time3,time4) {
k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(naive_dataset_ts,end = k)
fc_ts <- snaive(training_ts[,hotel_no], h = k1) %>% accuracy(naive_dataset_ts[,hotel_no])
return(fc_ts)
}
# create seasonal ARIMA forecast function
fc_Sarima <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q,P,D,Q) {
k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
training_ts <- subset(full_dataset_ts,end = k)
lambda <- BoxCox.lambda(training_ts)
fc_ts <- Arima(training_ts [,hotel_no],lambda = lambda,order=c(p,d,q),seasonal = c(P,D,Q),method ="CSS") %>% forecast(h = k1) %>% accuracy(full_dataset_ts[,hotel_no])
return(fc_ts)
}
# naive model forecast
# six-month forecasting errors
six_month <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30")
# three-month forecasting errors
three_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31")
three_month_2 <-fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28")
three_month_3 <-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31")
three_month_4 <-fc_snaive("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30")
# one-month forecasting errors
one_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30")
one_month_2<- fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31")
one_month_3<-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31")
one_month_4<-fc_snaive("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28")
one_month_5<-fc_snaive("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31")
one_month_6<-fc_snaive("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30")
# combine all the matrix
naive_result<-rbind(six_month,three_month_1,three_month_2,three_month_3,three_month_4,one_month_1,one_month_2,one_month_3,one_month_4,one_month_5,one_month_6)
# transfer to data frame and only keep test data result and MAE and MAPE
naive_result.df<- as.data.frame(naive_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2 ==1)
# rename the row name
naive_result<-data.frame(forecast_period= fc_timestamp, naive_result.df)
# SArima model forecast
## six-month forecasting errors
six_month_SArima <- fc_Sarima(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30",p,d,q,P,D,Q)
## three-month forecasting errors
three_month_1_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q,P,D,Q)
three_month_2_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q,P,D,Q)
three_month_3_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q,P,D,Q)
three_month_4_SArima<-fc_Sarima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q,P,D,Q)
## one-month forecasting errors
one_month_1_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q,P,D,Q)
one_month_2_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q,P,D,Q)
one_month_3_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q,P,D,Q)
one_month_4_SArima <-fc_Sarima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q,P,D,Q)
one_month_5_SArima <-fc_Sarima(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q,P,D,Q)
one_month_6_SArima <-fc_Sarima(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q,P,D,Q)
# combine all the matrix
Sarima_result<-rbind(six_month_SArima,three_month_1_SArima,three_month_2_SArima,three_month_3_SArima,three_month_4_SArima,one_month_1_SArima,one_month_2_SArima,one_month_3_SArima,one_month_4_SArima,one_month_5_SArima,one_month_6_SArima)
# transfer to data frame and only keep MAE and MAPE
Sarima_result.df<- as.data.frame(Sarima_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0|row_number()%%2==1)
# rename the row name
Sarima_result <-data.frame(forecast_period= fc_timestamp, Sarima_result.df)
# mutate MAPE as decimal number
Sarima_result <- Sarima_result %>% mutate(MAPE= MAPE/100)
# calculate MASE
Sarima_result <- Sarima_result %>% mutate(MASE = as.matrix(Sarima_result["MAE"])/as.matrix(naive_result["MAE"]))
# remove MASE for in-sample
Sarima_result <- Sarima_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
return(Sarima_result)
}
fc_result_arimasarima <- function(hotel_no,p,d,q,p_S,d_S,q_S,P,D,Q) {
k<-fc_result(hotel_no)
A<-fc_Arima_error (hotel_no,p,d,q)
SA<-fc_SArima_error (hotel_no,p_S,d_S,q_S,P,D,Q)
MASE <- data.frame(forecast_period=k[["naive"]][,1],Arima=A[,4],Sarima=SA[,4])
return(list(MASE=MASE))
}
fc_Arima_95pct <- function(hotel_no,p,d,q) {
# create ARIMA prediction interval function
fc_Arima_interval <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q) {
k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
training_ts <- subset(full_dataset_ts,end=k)
lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
## Arima model forecast
fc_Arima<- Arima(training_ts[,hotel_no], lambda = lambda, order=c(p,d,q)) %>% forecast(h=k1)
## retrieve value of interest
Arima_result <- data.frame(full_dataset[(k+1):(k+k1),c(1,(hotel_no+1))],fc=fc_Arima[["mean"]],Arima_low95pc = fc_Arima[["lower"]][,2],Arima_up95pc = fc_Arima[["upper"]][,2])
names(Arima_result)[1:2] =c("stay_date", "Final_arrival")
result <- Arima_result %>% mutate(Forecast = ifelse(Final_arrival >= Arima_low95pc & Final_arrival <= Arima_up95pc,1,0))
return(result)
}
# Get Arima model forecast interval result
## six-month forecasting errors
six_month_Arima <- fc_Arima_interval(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30", p,d,q)
## three-month forecasting errors
three_month_1_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q)
three_month_2_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q)
three_month_3_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q)
three_month_4_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q)
## one-month forecasting errors
one_month_1_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q)
one_month_2_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q)
one_month_3_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q)
one_month_4_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q)
one_month_5_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q)
one_month_6_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q)
# combine data as dataset
value<-c(mean(six_month_Arima$Forecast),mean(three_month_1_Arima$Forecast),mean(three_month_2_Arima$Forecast),mean(three_month_3_Arima$Forecast),mean(three_month_4_Arima$Forecast),mean(one_month_1_Arima$Forecast),mean(one_month_2_Arima $Forecast),mean(one_month_3_Arima$Forecast),mean(one_month_4_Arima$Forecast),mean(one_month_5_Arima $Forecast),mean(one_month_6_Arima $Forecast))
result <- data.frame(forecast_period= fc_timestamp,Arima_in_95pc = value)
return(result)
}
fc_SArima_95pct <- function(hotel_no,p,d,q,P,Q,D) {
# create SARIMA prediction interval function
fc_SArima_interval <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q,P,Q,D) {
k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
training_ts <- subset(full_dataset_ts,end=k)
lambda <- BoxCox.lambda(training_ts[,hotel_no])
## Arima model forecast
fc_SArima<- Arima(training_ts[,hotel_no], lambda=lambda,order=c(p,d,q),seasonal=c(P,Q,D),method ="CSS") %>% forecast(h=k1)
## retrieve value of interest
SArima_result <- data.frame(full_dataset[k+1:k1,c(1,hotel_no+1)],SArima_low95pc = fc_SArima[["lower"]][,2],SArima_up95pc = fc_SArima[["upper"]][,2])
names(SArima_result)[1:2] =c("stay_date", "Final_arrival")
result <- SArima_result %>% mutate(Forecast = ifelse(Final_arrival >= SArima_low95pc & Final_arrival <= SArima_up95pc,1,0))
return(result)
}
# Get Arima model forecast interval result
## six-month forecasting errors
six_month_SArima <- fc_SArima_interval(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30", p,d,q,P,Q,D)
## three-month forecasting errors
three_month_1_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q,P,Q,D)
three_month_2_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q,P,Q,D)
three_month_3_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q,P,Q,D)
three_month_4_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q,P,Q,D)
## one-month forecasting errors
one_month_1_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q,P,Q,D)
one_month_2_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q,P,Q,D)
one_month_3_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q,P,Q,D)
one_month_4_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q,P,Q,D)
one_month_5_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q,P,Q,D)
one_month_6_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q,P,Q,D)
# combine data as dataset
value <- c(mean(six_month_SArima$Forecast),mean(three_month_1_SArima$Forecast),mean(three_month_2_SArima$Forecast),mean(three_month_3_SArima$Forecast),mean(three_month_4_SArima$Forecast),mean(one_month_1_SArima$Forecast),mean(one_month_2_SArima $Forecast),mean(one_month_3_SArima$Forecast),mean(one_month_4_SArima$Forecast),mean(one_month_5_SArima $Forecast),mean(one_month_6_SArima $Forecast))
result <- data.frame(forecast_period= fc_timestamp,SArima_in_95pc = value)
return(result)
}
fc_result_across2 <- function(hotel_no,p,d,q,p_S,d_S,q_S,P,D,Q) {
k<-fc_result(hotel_no)
A<-fc_Arima_error (hotel_no,p,d,q)
SA<-fc_SArima_error (hotel_no,p_S,d_S,q_S,P,D,Q)
MAE <-data.frame(forecast_period= k[["naive"]][,1],ses=k[["ses"]][,2],holt=k[["holt"]][,2],hw_add=k[["hw_add"]][,2],hw_mul=k[["hw_mul"]][,2],Arima=A[,2],Sarima=SA[,2])
MAPE <-data.frame(forecast_period=k[["naive"]][,1],ses=k[["ses"]][,3],holt=k[["holt"]][,3],hw_add=k[["hw_add"]][,3],hw_mul=k[["hw_mul"]][,3],Arima=A[,3],Sarima=SA[,3])
MASE <- data.frame(forecast_period=k[["naive"]][,1],ses=k[["ses"]][,4],holt=k[["holt"]][,4],hw_add=k[["hw_add"]][,4],hw_mul=k[["hw_mul"]][,4],Arima=A[,4],Sarima=SA[,4])
return(list(MAE=MAE, MAPE=MAPE,MASE=MASE))
}
GLWST_auto <- fc_auto.arima(1)
summary(GLWST_auto)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(2,1,1)(1,0,0)[7]
## Box Cox transformation: lambda= 1.938722
##
## Coefficients:
## ar1 ar2 ma1 sar1
## 0.4554 0.0109 -0.9861 0.4539
## s.e. 0.0459 0.0446 0.0148 0.0425
##
## sigma^2 estimated as 1984229: log likelihood=-4750.35
## AIC=9510.71 AICc=9510.82 BIC=9532.24
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -1.513361 19.72568 14.78285 -8.126554 19.04953 0.7727172
## ACF1
## Training set 0.0628182
MLKEP_auto <- fc_auto.arima(2)
summary(MLKEP_auto)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(2,0,1)(1,1,2)[7] with drift
## Box Cox transformation: lambda= 0.1879901
##
## Coefficients:
## ar1 ar2 ma1 sar1 sma1 sma2 drift
## -0.2037 0.4838 0.7122 -0.4160 -0.3283 -0.5618 0.0016
## s.e. 0.1133 0.0596 0.1155 0.1711 0.1556 0.1313 0.0010
##
## sigma^2 estimated as 0.5537: log likelihood=-612.1
## AIC=1240.21 AICc=1240.48 BIC=1274.57
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 3.268526 25.59606 18.93021 -6.503847 27.10922 0.7048759
## ACF1
## Training set 0.06843749
WARUK_auto <- fc_auto.arima(3)
summary(WARUK_auto)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(2,0,0)(2,1,2)[7]
## Box Cox transformation: lambda= 0.5416263
##
## Coefficients:
## ar1 ar2 sar1 sar2 sma1 sma2
## 0.4176 -0.0669 -0.6263 -0.1129 -0.1726 -0.4762
## s.e. 0.0444 0.0434 0.1604 0.0654 0.1567 0.1436
##
## sigma^2 estimated as 10.7: log likelihood=-1412.32
## AIC=2838.64 AICc=2838.85 BIC=2868.71
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.8157666 22.77718 16.63593 -12.09121 29.56275 0.7094715
## ACF1
## Training set 0.01658621
# transform data with specific lambda
h01 <- in_sample_dataset_ts[,1]
autoplot(h01)
lambda <- BoxCox.lambda(h01)
lh01 <- BoxCox(h01,lambda)
autoplot(lh01)
# apply unit root test
lh01 %>% ur.kpss() %>% summary()
##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 6 lags.
##
## Value of test-statistic is: 0.4803
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739
lh01 %>% ndiffs()
## [1] 1
lh01 %>% diff() %>% ur.kpss() %>% summary()
##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 6 lags.
##
## Value of test-statistic is: 0.0165
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739
# acf pacf
# first diff
#lh01 %>% diff() %>% ggtsdisplay(main="Time Plot, ACF and PACF after first-order differencing")
# seasonal diff
#lh01 %>% diff(lag=7) %>% ggtsdisplay(main="seasonal differences")
# first and second diff
#lh01 %>% diff() %>% diff() %>% ggtsdisplay(main="second differences")
# seasonal diff and first diff
lh01 %>% diff(lag=7) %>% diff() %>% ggtsdisplay(main="Time Plot, ACF and PACF after first-order differencing and seasonal differencing")
# Benchmark AICc=9510.82 ARIMA(2,1,1)(1,0,0)[7]
GLWST_1 <- fc_Arima(1,7,1,2) #AICc=9509.8
summary(GLWST_1)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(7,1,2)
## Box Cox transformation: lambda= 1.938722
##
## Coefficients:
## ar1 ar2 ar3 ar4 ar5 ar6 ar7 ma1
## 0.0094 0.1545 0.1198 0.1105 -0.0777 -0.0675 0.4193 -0.5740
## s.e. 0.0694 0.0450 0.0392 0.0411 0.0396 0.0389 0.0389 0.0711
## ma2
## -0.4260
## s.e. 0.0706
##
## sigma^2 estimated as 1954107: log likelihood=-4744.7
## AIC=9509.39 AICc=9509.8 BIC=9552.45
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -1.649613 19.53779 14.54559 -8.317612 18.88443 0.7603152
## ACF1
## Training set 0.08617374
checkresiduals(GLWST_1)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(7,1,2)
## Q* = 18.808, df = 5, p-value = 0.002087
##
## Model df: 9. Total lags used: 14
#GLWST_2 <- fc_Arima(1,1,1,1) #AICc=9609.19
#summary(GLWST_2)
#GLWST_3 <- fc_Arima(1,0,1,2) #AICc=9602.75
#summary(GLWST_3)
GLWST_4 <- fc_Arima(1,7,1,21) #AICc=9456.41
summary(GLWST_4)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(7,1,21)
## Box Cox transformation: lambda= 1.938722
##
## Coefficients:
## ar1 ar2 ar3 ar4 ar5 ar6 ar7 ma1
## -0.5010 -0.4598 -0.4269 -0.4304 -0.4613 -0.4988 0.4824 0.0108
## s.e. 0.2241 0.2200 0.2093 0.2011 0.2030 0.2117 0.2204 0.2219
## ma2 ma3 ma4 ma5 ma6 ma7 ma8 ma9
## -0.0301 0.0151 0.0582 0.0010 0.0845 -0.7323 0.0414 -0.0198
## s.e. 0.1173 0.0655 0.0604 0.0634 0.0520 0.0559 0.1559 0.0858
## ma10 ma11 ma12 ma13 ma14 ma15 ma16 ma17
## 0.0087 0.0081 0.0105 -0.0022 -0.1527 0.0577 0.0579 -0.0529
## s.e. 0.0676 0.0560 0.0571 0.0517 0.0578 0.0463 0.0481 0.0478
## ma18 ma19 ma20 ma21
## -0.0295 0.0902 0.0727 0.0750
## s.e. 0.0462 0.0507 0.0521 0.0532
##
## sigma^2 estimated as 1683165: log likelihood=-4697.35
## AIC=9452.71 AICc=9456.07 BIC=9577.59
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -1.271447 17.80897 13.36571 -6.620254 16.97561 0.6986414
## ACF1
## Training set 0.07117836
checkresiduals(GLWST_4)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(7,1,21)
## Q* = 13.866, df = 3, p-value = 0.003094
##
## Model df: 28. Total lags used: 31
#GLWST_5 <- fc_Arima(1,3,2,1) #AICc=9646.07
#summary(GLWST_5)
#GLWST_6 <- fc_Arima(1,0,2,6) #AICc=9598.98
#summary(GLWST_6)
#GLWST_7 <- fc_Arima(1,6,2,21) #AICc=9458.78
#summary(GLWST_7)
fc_Arima_error(1,7,1,21)
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 13.41115 0.1704320 NaN
## 2 6m_Nov-Apr_out 28.22944 0.4849144 1.44174038323037
## 3 3m_Nov-Jan_in 13.41115 0.1704320 NaN
## 4 3m_Nov-Jan_out 32.90497 0.6434708 1.81056079420739
## 5 3m_Dec-Feb_in 13.29621 0.1686590 NaN
## 6 3m_Dec-Feb_out 29.66175 0.5812397 1.75282814004412
## 7 3m_Jan-Mar_in 13.57357 0.1809530 NaN
## 8 3m_Jan-Mar_out 20.97142 0.3045034 1.06634342353206
## 9 3m_Feb-Apr_in 13.74895 0.1810162 NaN
## 10 3m_Feb-Apr_out 21.97257 0.2175787 1.04463604086379
## 11 1m_Nov_in 13.41115 0.1704320 NaN
## 12 1m_Nov_out 13.66751 0.1586879 0.788510184726342
## 13 1m_Dec_in 13.29621 0.1686590 NaN
## 14 1m_Dec_out 29.85335 0.6612236 1.39375567094102
## 15 1m_Jan_in 13.57357 0.1809530 NaN
## 16 1m_Jan_out 23.11867 0.4809133 1.46860412244383
## 17 1m_Feb_in 13.74895 0.1810162 NaN
## 18 1m_Feb_out 16.79160 0.1681519 0.691419027631672
## 19 1m_Mar_in 13.50858 0.1770913 NaN
## 20 1m_Mar_out 19.07826 0.2350631 0.708294520670725
## 21 1m_Apr_in 13.86888 0.1875040 NaN
## 22 1m_Apr_out 18.83245 0.2348352 0.848308642611688
fc_Arima_error(1,7,1,2)
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 14.52801 0.1850786 NaN
## 2 6m_Nov-Apr_out 29.57394 0.5061296 1.51040716122949
## 3 3m_Nov-Jan_in 14.52801 0.1850786 NaN
## 4 3m_Nov-Jan_out 34.71262 0.6701543 1.91002470655003
## 5 3m_Dec-Feb_in 14.50098 0.1838467 NaN
## 6 3m_Dec-Feb_out 33.11938 0.6451855 1.95715290376984
## 7 3m_Jan-Mar_in 14.94337 0.1987186 NaN
## 8 3m_Jan-Mar_out 23.72852 0.3509090 1.20653480890996
## 9 3m_Feb-Apr_in 15.01093 0.1988081 NaN
## 10 3m_Feb-Apr_out 23.47816 0.2369889 1.11621591854316
## 11 1m_Nov_in 14.52801 0.1850786 NaN
## 12 1m_Nov_out 17.19369 0.1990354 0.991943628166903
## 13 1m_Dec_in 14.50098 0.1838467 NaN
## 14 1m_Dec_out 31.61924 0.7040996 1.47619952475317
## 15 1m_Jan_in 14.94337 0.1987186 NaN
## 16 1m_Jan_out 27.41032 0.5551548 1.74122909332112
## 17 1m_Feb_in 15.01093 0.1988081 NaN
## 18 1m_Feb_out 18.84691 0.1937591 0.776049052871373
## 19 1m_Mar_in 14.99985 0.1974268 NaN
## 20 1m_Mar_out 22.20607 0.2550257 0.824417090624261
## 21 1m_Apr_in 15.14658 0.2028084 NaN
## 22 1m_Apr_out 18.21139 0.2365036 0.820333077007016
fc_Arima_95pct(1,7,1,2)
## forecast_period Arima_in_95pc
## 1 6m_Nov-Apr_in 0.9116022
## 2 6m_Nov-Apr_out 0.8478261
## 3 3m_Nov-Jan_in 0.8333333
## 4 3m_Nov-Jan_out 0.9888889
## 5 3m_Dec-Feb_in 1.0000000
## 6 3m_Dec-Feb_out 1.0000000
## 7 3m_Jan-Mar_in 0.8709677
## 8 3m_Jan-Mar_out 0.9677419
## 9 3m_Feb-Apr_in 1.0000000
## 10 3m_Feb-Apr_out 0.9677419
## 11 1m_Nov_in 1.0000000
## 12 1m_Nov_out 0.9116022
## 13 1m_Dec_in 0.8478261
## 14 1m_Dec_out 0.8333333
## 15 1m_Jan_in 0.9888889
## 16 1m_Jan_out 1.0000000
## 17 1m_Feb_in 1.0000000
## 18 1m_Feb_out 0.8709677
## 19 1m_Mar_in 0.9677419
## 20 1m_Mar_out 1.0000000
## 21 1m_Apr_in 0.9677419
## 22 1m_Apr_out 1.0000000
# Benchmark AICc=9510.82 ARIMA(2,1,1)(1,0,0)[7]
#GLWST_S1 <- fc_SArima(1,1,0,1,1,1,3) #AICc=9338.35
#summary(GLWST_S1)
#GLWST_S2 <- fc_SArima(1,1,0,2,2,1,1) #AICc=9335.38
#summary(GLWST_S2)
#GLWST_S3 <- fc_SArima(1,3,1,1,2,1,3) #AICc=9324.79
#summary(GLWST_S3)
#GLWST_S4 <- fc_SArima(1,3,1,2,2,1,1) #AICc=9324.87
#summary(GLWST_S4)
GLWST_S5 <- fc_SArima(1,3,1,1,3,1,1) #AICc=9315.48
summary(GLWST_S5)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(3,1,1)(3,1,1)[7]
## Box Cox transformation: lambda= 1.938722
##
## Coefficients:
## ar1 ar2 ar3 ma1 sar1 sar2 sar3 sma1
## 0.4608 -0.0120 0.0371 -0.9555 0.1730 -0.0290 0.1372 -1.0000
## s.e. 0.0475 0.0494 0.0463 0.0207 0.0462 0.0451 0.0450 0.0277
##
## sigma^2 estimated as 1633525: log likelihood=-4648.57
## AIC=9315.14 AICc=9315.48 BIC=9353.78
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -1.332685 17.8589 13.16233 -6.569699 16.7904 0.6880105
## ACF1
## Training set 0.07267091
checkresiduals(GLWST_S5)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(3,1,1)(3,1,1)[7]
## Q* = 6.5598, df = 6, p-value = 0.3635
##
## Model df: 8. Total lags used: 14
#GLWST_S6 <- fc_SArima(1,7,0,0,0,1,2) #AICc=9338.51
#summary(GLWST_S6)
fc_SArima_error(1,3,1,1,3,1,1)
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 12.78628 0.1518631 NaN
## 2 6m_Nov-Apr_out 27.44858 0.4670655 1.40186015810188
## 3 3m_Nov-Jan_in 12.78628 0.1518631 NaN
## 4 3m_Nov-Jan_out 31.62772 0.6187564 1.7402813646935
## 5 3m_Dec-Feb_in 12.70031 0.1491647 NaN
## 6 3m_Dec-Feb_out 30.86518 0.6084707 1.82394341546168
## 7 3m_Jan-Mar_in 13.21222 0.1594099 NaN
## 8 3m_Jan-Mar_out 21.85138 0.3231854 1.16093541521193
## 9 3m_Feb-Apr_in 13.44758 0.1642157 NaN
## 10 3m_Feb-Apr_out 40.46131 0.3985930 1.92364140046507
## 11 1m_Nov_in 12.78628 0.1518631 NaN
## 12 1m_Nov_out 12.90527 0.1439459 0.744534984540394
## 13 1m_Dec_in 12.70031 0.1491647 NaN
## 14 1m_Dec_out 29.74818 0.6860186 1.38884559083622
## 15 1m_Jan_in 13.21222 0.1594099 NaN
## 16 1m_Jan_out 26.51960 0.5487885 1.68464703480619
## 17 1m_Feb_in 13.44758 0.1642157 NaN
## 18 1m_Feb_out 27.91918 0.2873494 1.14961313559584
## 19 1m_Mar_in 13.38701 0.1622929 NaN
## 20 1m_Mar_out 20.69215 0.2202115 0.768211656516521
## 21 1m_Apr_in 13.41851 0.1640141 NaN
## 22 1m_Apr_out 19.75689 0.2399248 0.889950128449772
fc_SArima_95pct(1,3,1,1,3,1,1)
## forecast_period SArima_in_95pc
## 1 6m_Nov-Apr_in 0.9944751
## 2 6m_Nov-Apr_out 0.9891304
## 3 3m_Nov-Jan_in 0.9666667
## 4 3m_Nov-Jan_out 0.9555556
## 5 3m_Dec-Feb_in 0.8314607
## 6 3m_Dec-Feb_out 1.0000000
## 7 3m_Jan-Mar_in 0.9354839
## 8 3m_Jan-Mar_out 0.9032258
## 9 3m_Feb-Apr_in 0.8928571
## 10 3m_Feb-Apr_out 0.9677419
## 11 1m_Nov_in 1.0000000
## 12 1m_Nov_out 0.9944751
## 13 1m_Dec_in 0.9891304
## 14 1m_Dec_out 0.9666667
## 15 1m_Jan_in 0.9555556
## 16 1m_Jan_out 0.8314607
## 17 1m_Feb_in 1.0000000
## 18 1m_Feb_out 0.9354839
## 19 1m_Mar_in 0.9032258
## 20 1m_Mar_out 0.8928571
## 21 1m_Apr_in 0.9677419
## 22 1m_Apr_out 1.0000000
GLWST_95interval <-cbind(fc_Arima_95pct(1,7,1,2),fc_SArima_95pct(1,3,1,1,3,1,1)[2])
GLWST_95interval <- txtRound(GLWST_95interval[-1],2)
GLWST_95interval <- data.frame(forecast_period = fc_timestamp, GLWST_95interval)
htmlTable(GLWST_95interval)
| forecast_period | Arima_in_95pc | SArima_in_95pc | |
|---|---|---|---|
| 1 | 6m_Nov-Apr_in | 0.91 | 0.99 |
| 2 | 6m_Nov-Apr_out | 0.85 | 0.99 |
| 3 | 3m_Nov-Jan_in | 0.83 | 0.97 |
| 4 | 3m_Nov-Jan_out | 0.99 | 0.96 |
| 5 | 3m_Dec-Feb_in | 1.00 | 0.83 |
| 6 | 3m_Dec-Feb_out | 1.00 | 1.00 |
| 7 | 3m_Jan-Mar_in | 0.87 | 0.94 |
| 8 | 3m_Jan-Mar_out | 0.97 | 0.90 |
| 9 | 3m_Feb-Apr_in | 1.00 | 0.89 |
| 10 | 3m_Feb-Apr_out | 0.97 | 0.97 |
| 11 | 1m_Nov_in | 1.00 | 1.00 |
| 12 | 1m_Nov_out | 0.91 | 0.99 |
| 13 | 1m_Dec_in | 0.85 | 0.99 |
| 14 | 1m_Dec_out | 0.83 | 0.97 |
| 15 | 1m_Jan_in | 0.99 | 0.96 |
| 16 | 1m_Jan_out | 1.00 | 0.83 |
| 17 | 1m_Feb_in | 1.00 | 1.00 |
| 18 | 1m_Feb_out | 0.87 | 0.94 |
| 19 | 1m_Mar_in | 0.97 | 0.90 |
| 20 | 1m_Mar_out | 1.00 | 0.89 |
| 21 | 1m_Apr_in | 0.97 | 0.97 |
| 22 | 1m_Apr_out | 1.00 | 1.00 |
Observations
fc_result_across2(1,7,1,2,3,1,1,3,1,1)
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## $MAE
## forecast_period ses holt hw_add hw_mul Arima Sarima
## 1 6m_Nov-Apr_in 17.16472 17.13131 14.23579 14.68280 14.52801 12.78628
## 2 6m_Nov-Apr_out 29.56734 30.70201 24.39895 24.82579 29.57394 27.44858
## 3 3m_Nov-Jan_in 17.16472 17.13131 14.23579 14.68280 14.52801 12.78628
## 4 3m_Nov-Jan_out 34.69838 35.46322 28.91156 29.40811 34.71262 31.62772
## 5 3m_Dec-Feb_in 17.14492 17.12651 14.03028 14.54415 14.50098 12.70031
## 6 3m_Dec-Feb_out 31.32584 31.26093 31.17146 30.20617 33.11938 30.86518
## 7 3m_Jan-Mar_in 17.62643 17.63378 14.47323 14.83175 14.94337 13.21222
## 8 3m_Jan-Mar_out 23.17962 23.73684 24.72472 21.86841 23.72852 21.85138
## 9 3m_Feb-Apr_in 17.48667 17.49045 14.55219 14.79067 15.01093 13.44758
## 10 3m_Feb-Apr_out 23.26497 24.07563 20.84123 18.11542 23.47816 40.46131
## 11 1m_Nov_in 17.16472 17.13131 14.23579 14.68280 14.52801 12.78628
## 12 1m_Nov_out 17.12180 17.26091 11.89435 12.17564 17.19369 12.90527
## 13 1m_Dec_in 17.14492 17.12651 14.03028 14.54415 14.50098 12.70031
## 14 1m_Dec_out 31.91392 31.88626 30.40857 30.03456 31.61924 29.74818
## 15 1m_Jan_in 17.62643 17.63378 14.47323 14.83175 14.94337 13.21222
## 16 1m_Jan_out 23.07441 22.93960 36.65615 33.55495 27.41032 26.51960
## 17 1m_Feb_in 17.98274 17.49045 14.55219 14.80548 15.01093 13.44758
## 18 1m_Feb_out 22.95372 20.46945 17.53358 19.02115 18.84691 27.91918
## 19 1m_Mar_in 17.55837 17.55315 14.58160 14.82875 14.99985 13.38701
## 20 1m_Mar_out 23.50660 23.66548 18.45737 20.02641 22.20607 20.69215
## 21 1m_Apr_in 17.73291 17.71103 14.59907 14.93417 15.14658 13.41851
## 22 1m_Apr_out 20.98610 21.30267 24.28184 24.55066 18.21139 19.75689
##
## $MAPE
## forecast_period ses holt hw_add hw_mul Arima
## 1 6m_Nov-Apr_in 0.2108561 0.2106789 0.1677099 0.1725621 0.1850786
## 2 6m_Nov-Apr_out 0.5061138 0.5241845 0.4202772 0.4277763 0.5061296
## 3 3m_Nov-Jan_in 0.2108561 0.2106789 0.1677099 0.1725621 0.1850786
## 4 3m_Nov-Jan_out 0.6701037 0.6845672 0.5722553 0.5808797 0.6701543
## 5 3m_Dec-Feb_in 0.2095655 0.2093029 0.1644125 0.1705139 0.1838467
## 6 3m_Dec-Feb_out 0.5987116 0.5973831 0.6116655 0.5924527 0.6451855
## 7 3m_Jan-Mar_in 0.2221101 0.2216822 0.1735547 0.1770651 0.1987186
## 8 3m_Jan-Mar_out 0.3181623 0.3190124 0.4175608 0.3419958 0.3509090
## 9 3m_Feb-Apr_in 0.2230310 0.2225737 0.1787784 0.1791103 0.1988081
## 10 3m_Feb-Apr_out 0.2405159 0.2452765 0.2081257 0.2121346 0.2369889
## 11 1m_Nov_in 0.2108561 0.2106789 0.1677099 0.1725621 0.1850786
## 12 1m_Nov_out 0.1985084 0.2005270 0.1286130 0.1328571 0.1990354
## 13 1m_Dec_in 0.2095655 0.2093029 0.1644125 0.1705139 0.1838467
## 14 1m_Dec_out 0.6757493 0.6750160 0.6878321 0.6715978 0.7040996
## 15 1m_Jan_in 0.2221101 0.2216822 0.1735547 0.1770651 0.1987186
## 16 1m_Jan_out 0.4614499 0.4567448 0.7486518 0.6932201 0.5551548
## 17 1m_Feb_in 0.2336794 0.2225737 0.1787784 0.1797262 0.1988081
## 18 1m_Feb_out 0.3156966 0.2174224 0.1833935 0.1945147 0.1937591
## 19 1m_Mar_in 0.2231886 0.2227842 0.1785943 0.1794635 0.1974268
## 20 1m_Mar_out 0.2679289 0.2683444 0.2129133 0.2262414 0.2550257
## 21 1m_Apr_in 0.2250199 0.2248767 0.1787301 0.1813381 0.2028084
## 22 1m_Apr_out 0.2778388 0.2819059 0.3053951 0.3060608 0.2365036
## Sarima
## 1 0.1518631
## 2 0.4670655
## 3 0.1518631
## 4 0.6187564
## 5 0.1491647
## 6 0.6084707
## 7 0.1594099
## 8 0.3231854
## 9 0.1642157
## 10 0.3985930
## 11 0.1518631
## 12 0.1439459
## 13 0.1491647
## 14 0.6860186
## 15 0.1594099
## 16 0.5487885
## 17 0.1642157
## 18 0.2873494
## 19 0.1622929
## 20 0.2202115
## 21 0.1640141
## 22 0.2399248
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 1.51007031723736 1.56802032878809 1.24610869159936
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 1.90924101308585 1.95132532723337 1.59082739119975
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 1.85116595265857 1.8473298401296 1.84204320025238
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 1.23150299808857 1.26110703952513 1.31359172056293
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 1.10608052462494 1.14462111892475 0.990849252153732
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 0.987796146118206 0.995821556838069 0.686212323034542
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 1.4899569826427 1.48866583852698 1.41967708388251
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 1.46579268309207 1.45722866851363 2.32856705580899
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.945153313792086 0.842859605534413 0.721970880917249
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 0.872700225739768 0.878598827909082 0.685243730902185
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 0.945319629121382 0.959579656671636 1.09377652193263
## hw_mul Arima Sarima
## 1 NaN NaN NaN
## 2 1.2679087638248 1.51040716122949 1.40186015810188
## 3 NaN NaN NaN
## 4 1.61814948410176 1.91002470655003 1.7402813646935
## 5 NaN NaN NaN
## 6 1.78500014535895 1.95715290376984 1.82394341546168
## 7 NaN NaN NaN
## 8 1.16183997927205 1.20653480890996 1.16093541521193
## 9 NaN NaN NaN
## 10 0.86125672682618 1.11621591854316 1.92364140046507
## 11 NaN NaN NaN
## 12 0.702440627424316 0.991943628166903 0.744534984540394
## 13 NaN NaN NaN
## 14 1.40221584981471 1.47619952475317 1.38884559083622
## 15 NaN NaN NaN
## 16 2.13156450930606 1.74122909332112 1.68464703480619
## 17 NaN NaN NaN
## 18 0.783223727928355 0.776049052871373 1.14961313559584
## 19 NaN NaN NaN
## 20 0.743495441486405 0.824417090624261 0.768211656516521
## 21 NaN NaN NaN
## 22 1.10588551357609 0.820333077007016 0.889950128449772
fc_result_arimasarima(1,7,1,2,3,1,1,3,1,1)
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## $MASE
## forecast_period Arima Sarima
## 1 6m_Nov-Apr_in NaN NaN
## 2 6m_Nov-Apr_out 1.51040716122949 1.40186015810188
## 3 3m_Nov-Jan_in NaN NaN
## 4 3m_Nov-Jan_out 1.91002470655003 1.7402813646935
## 5 3m_Dec-Feb_in NaN NaN
## 6 3m_Dec-Feb_out 1.95715290376984 1.82394341546168
## 7 3m_Jan-Mar_in NaN NaN
## 8 3m_Jan-Mar_out 1.20653480890996 1.16093541521193
## 9 3m_Feb-Apr_in NaN NaN
## 10 3m_Feb-Apr_out 1.11621591854316 1.92364140046507
## 11 1m_Nov_in NaN NaN
## 12 1m_Nov_out 0.991943628166903 0.744534984540394
## 13 1m_Dec_in NaN NaN
## 14 1m_Dec_out 1.47619952475317 1.38884559083622
## 15 1m_Jan_in NaN NaN
## 16 1m_Jan_out 1.74122909332112 1.68464703480619
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 0.776049052871373 1.14961313559584
## 19 1m_Mar_in NaN NaN
## 20 1m_Mar_out 0.824417090624261 0.768211656516521
## 21 1m_Apr_in NaN NaN
## 22 1m_Apr_out 0.820333077007016 0.889950128449772
GLWST_arimaerror <-data.frame(fc_result_arimasarima(1,7,1,2,3,1,1,3,1,1)) %>% filter(row_number()%%2 ==0)
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
GLWST_arimaerror<-txtRound(GLWST_arimaerror[,-1],2)
GLWST_arimaerror <- data.frame(forecast_period=fc_timestamp_out,GLWST_arimaerror)
htmlTable(GLWST_arimaerror)
| forecast_period | MASE.Arima | MASE.Sarima | |
|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 1.51 | 1.40 |
| 2 | 3m_Nov-Jan_out | 1.91 | 1.74 |
| 3 | 3m_Dec-Feb_out | 1.96 | 1.82 |
| 4 | 3m_Jan-Mar_out | 1.21 | 1.16 |
| 5 | 3m_Feb-Apr_out | 1.12 | 1.92 |
| 6 | 1m_Nov_out | 0.99 | 0.74 |
| 7 | 1m_Dec_out | 1.48 | 1.39 |
| 8 | 1m_Jan_out | 1.74 | 1.68 |
| 9 | 1m_Feb_out | 0.78 | 1.15 |
| 10 | 1m_Mar_out | 0.82 | 0.77 |
| 11 | 1m_Apr_out | 0.82 | 0.89 |
Observations
# transform data with specific lambda
h02 <- in_sample_dataset_ts[,2]
autoplot(h02)
lambda <- BoxCox.lambda(h02)
lh02 <- BoxCox(h02,lambda)
autoplot(lh02)
# apply unit root test
lh02 %>% ur.kpss() %>% summary()
##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 6 lags.
##
## Value of test-statistic is: 1.1955
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739
lh02 %>% ndiffs()
## [1] 1
lh02 %>% nsdiffs()
## [1] 1
# acf pacf
lh02 %>% diff() %>% ur.kpss() %>% summary()
##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 6 lags.
##
## Value of test-statistic is: 0.0461
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739
# no difference
lh02 %>% ggtsdisplay(main="Time Plot, ACF and PACF with no differencing")
# first
lh02 %>% diff() %>% ggtsdisplay(main="first difference")
# seasonal
lh02 %>% diff(lag=7) %>% ggtsdisplay(main="Time Plot, ACF and PACF after seasonal differencing")
# first and second
lh02 %>% diff() %>% diff() %>% ggtsdisplay(main="second difference")
# seasonal and first diff
lh02 %>% diff(lag=7) %>% diff() %>% ggtsdisplay(main="seasonal and first difference")
# Benchmark AICc=1240.48
#MLKEP_1 <- fc_Arima(2,1,0,2) # AICc=1768.3
#summary(MLKEP_1)
#MLKEP_2 <- fc_Arima(2,3,2,1) # AICc=1916.25
#summary(MLKEP_2)
#MLKEP_3 <- fc_Arima(2,1,1,1) # AICc=1798.65
#summary(MLKEP_3)
MLKEP_4 <- fc_Arima(2,1,0,21) # AICc=1486.97
summary(MLKEP_4)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(1,0,21) with non-zero mean
## Box Cox transformation: lambda= 0.1879901
##
## Coefficients:
## ar1 ma1 ma2 ma3 ma4 ma5 ma6 ma7
## 0.1707 0.2315 0.1785 -0.0439 0.0403 0.0443 0.0158 0.5736
## s.e. 0.2186 0.2160 0.0881 0.0661 0.0465 0.0466 0.0534 0.0519
## ma8 ma9 ma10 ma11 ma12 ma13 ma14 ma15
## 0.1571 0.1850 -0.0499 -0.0564 0.0494 0.0204 0.3633 0.1022
## s.e. 0.1179 0.0674 0.0763 0.0528 0.0597 0.0718 0.0491 0.0618
## ma16 ma17 ma18 ma19 ma20 ma21 mean
## 0.1061 -0.0259 -0.0160 0.0039 -0.0638 0.2582 6.8184
## s.e. 0.0571 0.0599 0.0482 0.0497 0.0687 0.0461 0.1395
##
## sigma^2 estimated as 0.83: log likelihood=-718.34
## AIC=1484.68 AICc=1486.97 BIC=1588.07
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 6.206727 31.29194 24.69189 -11.49305 35.88869 0.9194148
## ACF1
## Training set 0.1114995
checkresiduals(MLKEP_4)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,21) with non-zero mean
## Q* = 48.284, df = 3, p-value = 1.853e-10
##
## Model df: 23. Total lags used: 26
# Benchmark AICc=1240.48
#MLKEP_S1 <- fc_SArima(2,2,1,1,1,1,2) # 1239.37
#summary(MLKEP_S1)
#MLKEP_S2 <- fc_SArima(2,3,1,1,1,1,2)) # 1239.37
#summary(MLKEP_S2)
#MLKEP_S3 <- fc_SArima(2,1,1,1,1,1,2)) # 1238.11
#summary(MLKEP_S3)
#MLKEP_S4 <- fc_SArima(2,6,1,0,7,0,0)) # 1238.11
#summary(MLKEP_S3)
MLKEP_S4 <- fc_SArima(2,7,0,0,0,1,2) # 1230.5
summary(MLKEP_S4)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(7,0,0)(0,1,2)[7]
## Box Cox transformation: lambda= 0.1879901
##
## Coefficients:
## ar1 ar2 ar3 ar4 ar5 ar6 ar7 sma1
## 0.4782 0.0823 -0.0949 0.1750 -0.0031 0.0098 0.1427 -0.9184
## s.e. 0.0430 0.0474 0.0477 0.0486 0.0485 0.0481 0.0685 0.0883
## sma2
## -0.0326
## s.e. 0.0839
##
## sigma^2 estimated as 0.5405: log likelihood=-605.04
## AIC=1230.09 AICc=1230.5 BIC=1273.04
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 4.143843 25.69952 18.9932 -5.166946 26.53972 0.7072214
## ACF1
## Training set 0.08568077
checkresiduals(MLKEP_S4)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(7,0,0)(0,1,2)[7]
## Q* = 10.062, df = 5, p-value = 0.0735
##
## Model df: 9. Total lags used: 14
fc_Arima_error(2,1,0,21)
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 24.66547 0.3584096 NaN
## 2 6m_Nov-Apr_out 44.91730 0.6371228 2.39118581025824
## 3 3m_Nov-Jan_in 24.66547 0.3584096 NaN
## 4 3m_Nov-Jan_out 47.67571 0.7648333 2.48648833358686
## 5 3m_Dec-Feb_in 24.60048 0.3593358 NaN
## 6 3m_Dec-Feb_out 40.87112 0.7687634 2.40575563848602
## 7 3m_Jan-Mar_in 24.86703 0.3555949 NaN
## 8 3m_Jan-Mar_out 44.87847 0.6292966 2.50135465975378
## 9 3m_Feb-Apr_in 24.79729 0.3588897 NaN
## 10 3m_Feb-Apr_out 40.47731 0.4655955 2.20200506717963
## 11 1m_Nov_in 24.66547 0.3584096 NaN
## 12 1m_Nov_out 49.04758 0.4447614 2.37327010250779
## 13 1m_Dec_in 24.60048 0.3593358 NaN
## 14 1m_Dec_out 36.91538 0.6891902 1.82516251706604
## 15 1m_Jan_in 24.86703 0.3555949 NaN
## 16 1m_Jan_out 49.19573 0.8868399 2.9498407151449
## 17 1m_Feb_in 24.79729 0.3588897 NaN
## 18 1m_Feb_out 32.10311 0.3699352 0.518987849397563
## 19 1m_Mar_in 24.48886 0.3530501 NaN
## 20 1m_Mar_out 37.41415 0.3851852 2.18425383977721
## 21 1m_Apr_in 24.19597 0.3563215 NaN
## 22 1m_Apr_out 39.06601 0.4879097 1.6277505250801
fc_Arima_95pct(2,1,0,21)
## forecast_period Arima_in_95pc
## 1 6m_Nov-Apr_in 0.9723757
## 2 6m_Nov-Apr_out 0.9456522
## 3 3m_Nov-Jan_in 0.9333333
## 4 3m_Nov-Jan_out 0.9555556
## 5 3m_Dec-Feb_in 1.0000000
## 6 3m_Dec-Feb_out 1.0000000
## 7 3m_Jan-Mar_in 0.9354839
## 8 3m_Jan-Mar_out 0.8709677
## 9 3m_Feb-Apr_in 1.0000000
## 10 3m_Feb-Apr_out 1.0000000
## 11 1m_Nov_in 0.9666667
## 12 1m_Nov_out 0.9723757
## 13 1m_Dec_in 0.9456522
## 14 1m_Dec_out 0.9333333
## 15 1m_Jan_in 0.9555556
## 16 1m_Jan_out 1.0000000
## 17 1m_Feb_in 1.0000000
## 18 1m_Feb_out 0.9354839
## 19 1m_Mar_in 0.8709677
## 20 1m_Mar_out 1.0000000
## 21 1m_Apr_in 1.0000000
## 22 1m_Apr_out 0.9666667
fc_SArima_error(2,7,0,0,0,1,2)
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 18.46402 0.2725827 NaN
## 2 6m_Nov-Apr_out 26.39705 0.4186814 1.40525460249044
## 3 3m_Nov-Jan_in 18.46402 0.2725827 NaN
## 4 3m_Nov-Jan_out 32.78799 0.6012078 1.71003120065922
## 5 3m_Dec-Feb_in 18.43547 0.2655255 NaN
## 6 3m_Dec-Feb_out 27.55973 0.6327700 1.62222069380101
## 7 3m_Jan-Mar_in 18.66958 0.2708815 NaN
## 8 3m_Jan-Mar_out 22.83732 0.2926796 1.4343049976313
## 9 3m_Feb-Apr_in 18.65998 0.2754222 NaN
## 10 3m_Feb-Apr_out 18.75691 0.2054855 1.02039410524754
## 11 1m_Nov_in 18.46402 0.2725827 NaN
## 12 1m_Nov_out 30.02807 0.2533241 1.45297091409669
## 13 1m_Dec_in 18.43547 0.2655255 NaN
## 14 1m_Dec_out 35.66195 0.8870637 1.76319041440316
## 15 1m_Jan_in 18.66958 0.2708815 NaN
## 16 1m_Jan_out 27.72846 0.4678975 1.6626348866122
## 17 1m_Feb_in 18.65998 0.2754222 NaN
## 18 1m_Feb_out 12.85905 0.1468516 0.207882977134548
## 19 1m_Mar_in 18.33819 0.2693435 NaN
## 20 1m_Mar_out 18.23914 0.1734935 1.06480848108438
## 21 1m_Apr_in 18.27448 0.2721646 NaN
## 22 1m_Apr_out 18.97741 0.2418188 0.790725306183894
fc_SArima_95pct(2,7,0,0,0,1,2)
## forecast_period SArima_in_95pc
## 1 6m_Nov-Apr_in 0.9558011
## 2 6m_Nov-Apr_out 0.9130435
## 3 3m_Nov-Jan_in 0.8888889
## 4 3m_Nov-Jan_out 0.9777778
## 5 3m_Dec-Feb_in 0.9887640
## 6 3m_Dec-Feb_out 1.0000000
## 7 3m_Jan-Mar_in 0.8064516
## 8 3m_Jan-Mar_out 0.9354839
## 9 3m_Feb-Apr_in 1.0000000
## 10 3m_Feb-Apr_out 0.9677419
## 11 1m_Nov_in 0.9666667
## 12 1m_Nov_out 0.9558011
## 13 1m_Dec_in 0.9130435
## 14 1m_Dec_out 0.8888889
## 15 1m_Jan_in 0.9777778
## 16 1m_Jan_out 0.9887640
## 17 1m_Feb_in 1.0000000
## 18 1m_Feb_out 0.8064516
## 19 1m_Mar_in 0.9354839
## 20 1m_Mar_out 1.0000000
## 21 1m_Apr_in 0.9677419
## 22 1m_Apr_out 0.9666667
MLKEP_95interval <- cbind(fc_Arima_95pct(2,1,0,21),fc_SArima_95pct(2,7,0,0,0,1,2)[2])
MLKEP_95interval <- txtRound(MLKEP_95interval[-1],2)
MLKEP_95interval <- data.frame(forecast_period = fc_timestamp,MLKEP_95interval)
htmlTable(MLKEP_95interval)
| forecast_period | Arima_in_95pc | SArima_in_95pc | |
|---|---|---|---|
| 1 | 6m_Nov-Apr_in | 0.97 | 0.96 |
| 2 | 6m_Nov-Apr_out | 0.95 | 0.91 |
| 3 | 3m_Nov-Jan_in | 0.93 | 0.89 |
| 4 | 3m_Nov-Jan_out | 0.96 | 0.98 |
| 5 | 3m_Dec-Feb_in | 1.00 | 0.99 |
| 6 | 3m_Dec-Feb_out | 1.00 | 1.00 |
| 7 | 3m_Jan-Mar_in | 0.94 | 0.81 |
| 8 | 3m_Jan-Mar_out | 0.87 | 0.94 |
| 9 | 3m_Feb-Apr_in | 1.00 | 1.00 |
| 10 | 3m_Feb-Apr_out | 1.00 | 0.97 |
| 11 | 1m_Nov_in | 0.97 | 0.97 |
| 12 | 1m_Nov_out | 0.97 | 0.96 |
| 13 | 1m_Dec_in | 0.95 | 0.91 |
| 14 | 1m_Dec_out | 0.93 | 0.89 |
| 15 | 1m_Jan_in | 0.96 | 0.98 |
| 16 | 1m_Jan_out | 1.00 | 0.99 |
| 17 | 1m_Feb_in | 1.00 | 1.00 |
| 18 | 1m_Feb_out | 0.94 | 0.81 |
| 19 | 1m_Mar_in | 0.87 | 0.94 |
| 20 | 1m_Mar_out | 1.00 | 1.00 |
| 21 | 1m_Apr_in | 1.00 | 0.97 |
| 22 | 1m_Apr_out | 0.97 | 0.97 |
fc_result_across2(2,1,0,21,7,0,0,0,1,2)
## $MAE
## forecast_period ses holt hw_add hw_mul Arima Sarima
## 1 6m_Nov-Apr_in 38.77455 38.77184 21.18071 20.90222 24.66547 18.46402
## 2 6m_Nov-Apr_out 45.49341 45.18002 40.44032 46.23437 44.91730 26.39705
## 3 3m_Nov-Jan_in 38.77455 38.77184 21.18071 20.90222 24.66547 18.46402
## 4 3m_Nov-Jan_out 47.99566 48.14022 43.31319 46.65270 47.67571 32.78799
## 5 3m_Dec-Feb_in 39.16804 39.15002 21.04567 20.98880 24.60048 18.43547
## 6 3m_Dec-Feb_out 50.00241 51.81970 33.81385 31.80701 40.87112 27.55973
## 7 3m_Jan-Mar_in 39.39255 39.39627 21.49253 21.03735 24.86703 18.66958
## 8 3m_Jan-Mar_out 50.20995 50.49698 72.18988 60.41168 44.87847 22.83732
## 9 3m_Feb-Apr_in 39.80263 39.80379 21.73913 20.74706 24.79729 18.65998
## 10 3m_Feb-Apr_out 41.25520 40.99548 19.07638 29.57399 40.47731 18.75691
## 11 1m_Nov_in 38.77455 38.77184 21.18071 20.90222 24.66547 18.46402
## 12 1m_Nov_out 51.26677 51.00898 49.68810 55.99825 49.04758 30.02807
## 13 1m_Dec_in 39.16804 39.15002 21.04567 20.98880 24.60048 18.43547
## 14 1m_Dec_out 53.11451 54.45684 41.05527 38.70986 36.91538 35.66195
## 15 1m_Jan_in 39.39255 39.39627 21.49253 21.03735 24.86703 18.66958
## 16 1m_Jan_out 47.38678 47.48135 63.69622 51.55298 49.19573 27.72846
## 17 1m_Feb_in 37.75368 39.80379 21.73913 20.82137 24.79729 18.65998
## 18 1m_Feb_out 41.83729 38.40744 13.61814 19.70531 32.10311 12.85905
## 19 1m_Mar_in 39.82918 39.83565 21.39390 20.43778 24.48886 18.33819
## 20 1m_Mar_out 43.19087 42.83800 19.74626 23.01562 37.41415 18.23914
## 21 1m_Apr_in 40.01951 40.02174 21.21729 20.25453 24.19597 18.27448
## 22 1m_Apr_out 41.47564 41.52681 28.07609 26.44477 39.06601 18.97741
##
## $MAPE
## forecast_period ses holt hw_add hw_mul Arima
## 1 6m_Nov-Apr_in 0.6473017 0.6530131 0.3412081 0.3028179 0.3584096
## 2 6m_Nov-Apr_out 0.6153640 0.6353902 0.5024606 0.4668452 0.6371228
## 3 3m_Nov-Jan_in 0.6473017 0.6530131 0.3412081 0.3028179 0.3584096
## 4 3m_Nov-Jan_out 0.7401124 0.7608638 0.5902200 0.5149623 0.7648333
## 5 3m_Dec-Feb_in 0.6428962 0.6521671 0.3352257 0.2980816 0.3593358
## 6 3m_Dec-Feb_out 1.1311959 1.2004435 0.8216322 0.7622298 0.7687634
## 7 3m_Jan-Mar_in 0.6515307 0.6538105 0.3512270 0.3050282 0.3555949
## 8 3m_Jan-Mar_out 0.5595839 0.5582343 0.9358860 0.5931100 0.6292966
## 9 3m_Feb-Apr_in 0.6625364 0.6674092 0.3611149 0.3094236 0.3588897
## 10 3m_Feb-Apr_out 0.5546310 0.5695227 0.2145234 0.2689125 0.4655955
## 11 1m_Nov_in 0.6473017 0.6530131 0.3412081 0.3028179 0.3584096
## 12 1m_Nov_out 0.4941932 0.4954742 0.4818548 0.4579445 0.4447614
## 13 1m_Dec_in 0.6428962 0.6521671 0.3352257 0.2980816 0.3593358
## 14 1m_Dec_out 1.1402568 1.1848696 1.0512742 0.9927841 0.6891902
## 15 1m_Jan_in 0.6515307 0.6538105 0.3512270 0.3050282 0.3555949
## 16 1m_Jan_out 0.7364310 0.7317912 0.9687336 0.5470016 0.8868399
## 17 1m_Feb_in 0.6856247 0.6674092 0.3611149 0.3106785 0.3588897
## 18 1m_Feb_out 0.6715170 0.5613361 0.1660205 0.1947078 0.3699352
## 19 1m_Mar_in 0.6603712 0.6656321 0.3539051 0.3023790 0.3530501
## 20 1m_Mar_out 0.5349947 0.5384868 0.1909887 0.2088241 0.3851852
## 21 1m_Apr_in 0.6597906 0.6658463 0.3482126 0.2990208 0.3563215
## 22 1m_Apr_out 0.6605126 0.6709377 0.3355028 0.2833986 0.4879097
## Sarima
## 1 0.2725827
## 2 0.4186814
## 3 0.2725827
## 4 0.6012078
## 5 0.2655255
## 6 0.6327700
## 7 0.2708815
## 8 0.2926796
## 9 0.2754222
## 10 0.2054855
## 11 0.2725827
## 12 0.2533241
## 13 0.2655255
## 14 0.8870637
## 15 0.2708815
## 16 0.4678975
## 17 0.2754222
## 18 0.1468516
## 19 0.2693435
## 20 0.1734935
## 21 0.2721646
## 22 0.2418188
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 2.42185488485271 2.40517140567444 2.15285208085992
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 2.50317495996648 2.51071420616879 2.2589643205019
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 2.94324218994747 3.05021113893062 1.99035089593933
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 3.15345143621606 3.17147789239688 4.53390757349255
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 2.24432329807167 2.23019396058413 1.03777373155899
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 2.48065023694255 2.46817641736297 2.40426284125621
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 2.62607600778802 2.69244325136226 2.02984596452465
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 2.84137377443743 2.84704398921894 3.81930887153841
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.676353494652262 0.620905457428594 0.220154760923705
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 2.52150109191934 2.50090002175195 1.15279466596787
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 1.72815186029591 1.73028354206183 1.16983687695675
## hw_mul Arima Sarima
## 1 NaN NaN NaN
## 2 2.46130027007225 2.39118581025824 1.40525460249044
## 3 NaN NaN NaN
## 4 2.43313398617843 2.48648833358686 1.71003120065922
## 5 NaN NaN NaN
## 6 1.87222417169747 2.40575563848602 1.62222069380101
## 7 NaN NaN NaN
## 8 3.7941741061251 2.50135465975378 1.4343049976313
## 9 NaN NaN NaN
## 10 1.60885381507066 2.20200506717963 1.02039410524754
## 11 NaN NaN NaN
## 12 2.70959288322267 2.37327010250779 1.45297091409669
## 13 NaN NaN NaN
## 14 1.91388482490275 1.82516251706604 1.76319041440316
## 15 NaN NaN NaN
## 16 3.09118460927018 2.9498407151449 1.6626348866122
## 17 NaN NaN NaN
## 18 0.318561626986709 0.518987849397563 0.207882977134548
## 19 NaN NaN NaN
## 20 1.34366115083376 2.18425383977721 1.06480848108438
## 21 NaN NaN NaN
## 22 1.101865510774 1.6277505250801 0.790725306183894
fc_result_arimasarima(2,1,0,21,7,0,0,0,1,2)
## $MASE
## forecast_period Arima Sarima
## 1 6m_Nov-Apr_in NaN NaN
## 2 6m_Nov-Apr_out 2.39118581025824 1.40525460249044
## 3 3m_Nov-Jan_in NaN NaN
## 4 3m_Nov-Jan_out 2.48648833358686 1.71003120065922
## 5 3m_Dec-Feb_in NaN NaN
## 6 3m_Dec-Feb_out 2.40575563848602 1.62222069380101
## 7 3m_Jan-Mar_in NaN NaN
## 8 3m_Jan-Mar_out 2.50135465975378 1.4343049976313
## 9 3m_Feb-Apr_in NaN NaN
## 10 3m_Feb-Apr_out 2.20200506717963 1.02039410524754
## 11 1m_Nov_in NaN NaN
## 12 1m_Nov_out 2.37327010250779 1.45297091409669
## 13 1m_Dec_in NaN NaN
## 14 1m_Dec_out 1.82516251706604 1.76319041440316
## 15 1m_Jan_in NaN NaN
## 16 1m_Jan_out 2.9498407151449 1.6626348866122
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 0.518987849397563 0.207882977134548
## 19 1m_Mar_in NaN NaN
## 20 1m_Mar_out 2.18425383977721 1.06480848108438
## 21 1m_Apr_in NaN NaN
## 22 1m_Apr_out 1.6277505250801 0.790725306183894
MLKEP_arimaerror <-data.frame(fc_result_arimasarima(2,1,0,21,7,0,0,0,1,2)) %>% filter(row_number()%%2 ==0)
MLKEP_arimaerror<-txtRound(MLKEP_arimaerror[,-1],2)
MLKEP_arimaerror <- data.frame(forecast_period=fc_timestamp_out,MLKEP_arimaerror)
htmlTable(MLKEP_arimaerror)
| forecast_period | MASE.Arima | MASE.Sarima | |
|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 2.39 | 1.41 |
| 2 | 3m_Nov-Jan_out | 2.49 | 1.71 |
| 3 | 3m_Dec-Feb_out | 2.41 | 1.62 |
| 4 | 3m_Jan-Mar_out | 2.50 | 1.43 |
| 5 | 3m_Feb-Apr_out | 2.20 | 1.02 |
| 6 | 1m_Nov_out | 2.37 | 1.45 |
| 7 | 1m_Dec_out | 1.83 | 1.76 |
| 8 | 1m_Jan_out | 2.95 | 1.66 |
| 9 | 1m_Feb_out | 0.52 | 0.21 |
| 10 | 1m_Mar_out | 2.18 | 1.06 |
| 11 | 1m_Apr_out | 1.63 | 0.79 |
Observations
# transform data with specific lambda
h03 <- in_sample_dataset_ts[,3]
autoplot(h03)
lambda <- BoxCox.lambda(h03)
lh03 <- BoxCox(h03,lambda)
autoplot(lh03)
# apply unit root test
lh03 %>% ur.kpss() %>% summary()
##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 6 lags.
##
## Value of test-statistic is: 1.2203
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739
lh03 %>% nsdiffs()
## [1] 1
lh03 %>% diff(lag=7) %>% ndiffs()
## [1] 0
lh03 %>% diff(lag=7) %>% ur.kpss() %>% summary() # pass the root test for stationarity
##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 6 lags.
##
## Value of test-statistic is: 0.0281
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739
# acf pacf
# first diff
lh03 %>% diff() %>% ggtsdisplay(main="first difference")
# seasonal diff
lh03 %>% diff(lag=7) %>% ggtsdisplay(main="seasonal difference")
# first and second diff
lh03 %>% diff() %>% diff() %>% ggtsdisplay(main="second difference")
# seasonal diff and first diff
lh03 %>% diff(lag=7) %>% diff() %>% ggtsdisplay(main="seasonal and first difference")
# Benchmark AICc=2838.85 ARIMA(2,0,0)(2,1,2)[7]
#WARUK_1 <- fc_Arima(3,0,1,21) #AICc=3089.93
#summary(WARUK_1)
WARUK_2 <- fc_Arima(3,6,1,1) #AICc=3050.76
summary(WARUK_2)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(6,1,1)
## Box Cox transformation: lambda= 0.5416263
##
## Coefficients:
## ar1 ar2 ar3 ar4 ar5 ar6 ma1
## -0.9628 -0.8862 -0.8303 -0.7489 -0.7223 -0.6998 0.3058
## s.e. 0.0419 0.0443 0.0479 0.0463 0.0410 0.0304 0.0562
##
## sigma^2 estimated as 14.94: log likelihood=-1517.25
## AIC=3050.49 AICc=3050.76 BIC=3084.94
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 1.843925 26.96794 20.99659 -15.49273 37.48797 0.8954405
## ACF1
## Training set 0.03452756
checkresiduals(WARUK_2)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(6,1,1)
## Q* = 41.233, df = 7, p-value = 7.303e-07
##
## Model df: 7. Total lags used: 14
#WARUK_3 <- fc_Arima(3,6,1,0) #AICc=3071.94
#summary(WARUK_3)
# Benchmark AICc=2838.85 ARIMA(2,0,0)(2,1,2)[7]
#WARUK_S1 <- fc_SArima(3,1,0,1,2,1,1) #AICc=2842.54
#summary(WARUK_S1)
#WARUK_S2 <- fc_SArima(3,1,0,2,2,1,1) #AICc=2844.02
#summary(WARUK_S2)
#WARUK_S3 <- fc_SArima(3,1,0,1,3,1,1) #AICc=2824.48
#summary(WARUK_S3)
#WARUK_S4 <- fc_SArima(3,0,1,1,0,1,1) #AICc=2902.7
#summary(WARUK_S4)
WARUK_S5 <- fc_SArima(3,8,0,1,2,1,1) #AICc=2819.74
summary(WARUK_S5)
## Series: in_sample_dataset_ts[, hotel_no]
## ARIMA(8,0,1)(2,1,1)[7]
## Box Cox transformation: lambda= 0.5416263
##
## Coefficients:
## ar1 ar2 ar3 ar4 ar5 ar6 ar7 ar8
## 0.0588 0.0689 -0.0174 0.0218 0.0024 0.0718 0.6733 0.0292
## s.e. 0.0905 0.0298 0.0409 0.0419 0.0602 0.0571 0.0080 0.0676
## ma1 sar1 sar2 sma1
## 0.3538 -0.5415 -0.3284 -0.9994
## s.e. 0.0962 0.1115 0.0446 0.0374
##
## sigma^2 estimated as 9.9: log likelihood=-1396.53
## AIC=2819.05 AICc=2819.74 BIC=2874.89
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.7102529 21.90257 16.16122 -11.50519 28.34849 0.6892268
## ACF1
## Training set 0.01920445
checkresiduals(WARUK_S5)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(8,0,1)(2,1,1)[7]
## Q* = 5.0988, df = 3, p-value = 0.1647
##
## Model df: 12. Total lags used: 15
fc_Arima_error(3,6,1,1)
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 20.70676 0.3703259 NaN
## 2 6m_Nov-Apr_out 26.52724 0.7230100 1.19527754309856
## 3 3m_Nov-Jan_in 20.70676 0.3703259 NaN
## 4 3m_Nov-Jan_out 27.87766 0.8772148 1.19512784390653
## 5 3m_Dec-Feb_in 20.67735 0.3822292 NaN
## 6 3m_Dec-Feb_out 27.62729 0.9418174 1.45491867240685
## 7 3m_Jan-Mar_in 20.61937 0.3864812 NaN
## 8 3m_Jan-Mar_out 37.18457 0.5293566 1.85305151574134
## 9 3m_Feb-Apr_in 20.27470 0.3824043 NaN
## 10 3m_Feb-Apr_out 23.33238 0.4917265 1.10987817186834
## 11 1m_Nov_in 20.70676 0.3703259 NaN
## 12 1m_Nov_out 27.26544 0.5532158 1.01484252776394
## 13 1m_Dec_in 20.67735 0.3822292 NaN
## 14 1m_Dec_out 26.51127 1.0892604 1.02347369064707
## 15 1m_Jan_in 20.61937 0.3864812 NaN
## 16 1m_Jan_out 26.10291 0.4777408 1.50687212146416
## 17 1m_Feb_in 20.27470 0.3824043 NaN
## 18 1m_Feb_out 20.49617 0.3413123 0.435757623412606
## 19 1m_Mar_in 20.28507 0.3804409 NaN
## 20 1m_Mar_out 18.25195 0.2917256 1.0176449326799
## 21 1m_Apr_in 20.12943 0.3853128 NaN
## 22 1m_Apr_out 23.82032 0.7483806 0.755401242935939
fc_Arima_95pct(3,6,1,1)
## forecast_period Arima_in_95pc
## 1 6m_Nov-Apr_in 1.0000000
## 2 6m_Nov-Apr_out 1.0000000
## 3 3m_Nov-Jan_in 1.0000000
## 4 3m_Nov-Jan_out 0.9333333
## 5 3m_Dec-Feb_in 1.0000000
## 6 3m_Dec-Feb_out 1.0000000
## 7 3m_Jan-Mar_in 1.0000000
## 8 3m_Jan-Mar_out 0.8387097
## 9 3m_Feb-Apr_in 1.0000000
## 10 3m_Feb-Apr_out 1.0000000
## 11 1m_Nov_in 0.9333333
## 12 1m_Nov_out 1.0000000
## 13 1m_Dec_in 1.0000000
## 14 1m_Dec_out 1.0000000
## 15 1m_Jan_in 0.9333333
## 16 1m_Jan_out 1.0000000
## 17 1m_Feb_in 1.0000000
## 18 1m_Feb_out 1.0000000
## 19 1m_Mar_in 0.8387097
## 20 1m_Mar_out 1.0000000
## 21 1m_Apr_in 1.0000000
## 22 1m_Apr_out 0.9333333
Observations
fc_SArima_error(3,8,0,1,2,1,1)
## forecast_period MAE MAPE MASE
## 1 6m_Nov-Apr_in 15.84349 0.2875175 NaN
## 2 6m_Nov-Apr_out 21.29873 0.6557749 0.959688942439446
## 3 3m_Nov-Jan_in 15.84349 0.2875175 NaN
## 4 3m_Nov-Jan_out 25.02444 0.8917202 1.07280898867372
## 5 3m_Dec-Feb_in 15.88532 0.2890496 NaN
## 6 3m_Dec-Feb_out 23.60316 0.8286613 1.24299822402762
## 7 3m_Jan-Mar_in 16.08653 0.3058562 NaN
## 8 3m_Jan-Mar_out 25.68798 0.4002496 1.58133921290795
## 9 3m_Feb-Apr_in 15.92285 0.3037107 NaN
## 10 3m_Feb-Apr_out 19.40728 0.3589227 0.923168199447218
## 11 1m_Nov_in 15.84349 0.2875175 NaN
## 12 1m_Nov_out 18.68239 0.4104857 0.695374142575834
## 13 1m_Dec_in 15.88532 0.2890496 NaN
## 14 1m_Dec_out 31.23456 1.3064874 1.20581754966476
## 15 1m_Jan_in 16.08653 0.3058562 NaN
## 16 1m_Jan_out 21.75883 0.4729108 1.25609650300468
## 17 1m_Feb_in 15.92285 0.3037107 NaN
## 18 1m_Feb_out 17.85865 0.2609324 0.379682774598811
## 19 1m_Mar_in 15.95166 0.3022490 NaN
## 20 1m_Mar_out 16.00217 0.2317217 0.892207532174453
## 21 1m_Apr_in 15.86604 0.3034632 NaN
## 22 1m_Apr_out 17.38110 0.5815646 0.551197655068417
fc_SArima_95pct(3,8,0,1,2,1,1)
## forecast_period SArima_in_95pc
## 1 6m_Nov-Apr_in 0.9281768
## 2 6m_Nov-Apr_out 0.8695652
## 3 3m_Nov-Jan_in 0.9000000
## 4 3m_Nov-Jan_out 0.9444444
## 5 3m_Dec-Feb_in 0.9775281
## 6 3m_Dec-Feb_out 0.9666667
## 7 3m_Jan-Mar_in 0.7741935
## 8 3m_Jan-Mar_out 0.9032258
## 9 3m_Feb-Apr_in 0.9642857
## 10 3m_Feb-Apr_out 1.0000000
## 11 1m_Nov_in 0.9000000
## 12 1m_Nov_out 0.9281768
## 13 1m_Dec_in 0.8695652
## 14 1m_Dec_out 0.9000000
## 15 1m_Jan_in 0.9444444
## 16 1m_Jan_out 0.9775281
## 17 1m_Feb_in 0.9666667
## 18 1m_Feb_out 0.7741935
## 19 1m_Mar_in 0.9032258
## 20 1m_Mar_out 0.9642857
## 21 1m_Apr_in 1.0000000
## 22 1m_Apr_out 0.9000000
WARUK_95interval <- cbind(fc_Arima_95pct(3,6,1,1),fc_SArima_95pct(3,8,0,1,2,1,1)[2])
WARUK_95interval <- txtRound(WARUK_95interval[-1],2)
WARUK_95interval <- data.frame(forecast_period = fc_timestamp,WARUK_95interval)
htmlTable(WARUK_95interval)
| forecast_period | Arima_in_95pc | SArima_in_95pc | |
|---|---|---|---|
| 1 | 6m_Nov-Apr_in | 1.00 | 0.93 |
| 2 | 6m_Nov-Apr_out | 1.00 | 0.87 |
| 3 | 3m_Nov-Jan_in | 1.00 | 0.90 |
| 4 | 3m_Nov-Jan_out | 0.93 | 0.94 |
| 5 | 3m_Dec-Feb_in | 1.00 | 0.98 |
| 6 | 3m_Dec-Feb_out | 1.00 | 0.97 |
| 7 | 3m_Jan-Mar_in | 1.00 | 0.77 |
| 8 | 3m_Jan-Mar_out | 0.84 | 0.90 |
| 9 | 3m_Feb-Apr_in | 1.00 | 0.96 |
| 10 | 3m_Feb-Apr_out | 1.00 | 1.00 |
| 11 | 1m_Nov_in | 0.93 | 0.90 |
| 12 | 1m_Nov_out | 1.00 | 0.93 |
| 13 | 1m_Dec_in | 1.00 | 0.87 |
| 14 | 1m_Dec_out | 1.00 | 0.90 |
| 15 | 1m_Jan_in | 0.93 | 0.94 |
| 16 | 1m_Jan_out | 1.00 | 0.98 |
| 17 | 1m_Feb_in | 1.00 | 0.97 |
| 18 | 1m_Feb_out | 1.00 | 0.77 |
| 19 | 1m_Mar_in | 0.84 | 0.90 |
| 20 | 1m_Mar_out | 1.00 | 0.96 |
| 21 | 1m_Apr_in | 1.00 | 1.00 |
| 22 | 1m_Apr_out | 0.93 | 0.90 |
fc_result_arimasarima(3,6,1,1,8,0,1,2,1,1)
## $MASE
## forecast_period Arima Sarima
## 1 6m_Nov-Apr_in NaN NaN
## 2 6m_Nov-Apr_out 1.19527754309856 0.959688942439446
## 3 3m_Nov-Jan_in NaN NaN
## 4 3m_Nov-Jan_out 1.19512784390653 1.07280898867372
## 5 3m_Dec-Feb_in NaN NaN
## 6 3m_Dec-Feb_out 1.45491867240685 1.24299822402762
## 7 3m_Jan-Mar_in NaN NaN
## 8 3m_Jan-Mar_out 1.85305151574134 1.58133921290795
## 9 3m_Feb-Apr_in NaN NaN
## 10 3m_Feb-Apr_out 1.10987817186834 0.923168199447218
## 11 1m_Nov_in NaN NaN
## 12 1m_Nov_out 1.01484252776394 0.695374142575834
## 13 1m_Dec_in NaN NaN
## 14 1m_Dec_out 1.02347369064707 1.20581754966476
## 15 1m_Jan_in NaN NaN
## 16 1m_Jan_out 1.50687212146416 1.25609650300468
## 17 1m_Feb_in NaN NaN
## 18 1m_Feb_out 0.435757623412606 0.379682774598811
## 19 1m_Mar_in NaN NaN
## 20 1m_Mar_out 1.0176449326799 0.892207532174453
## 21 1m_Apr_in NaN NaN
## 22 1m_Apr_out 0.755401242935939 0.551197655068417
WARUK_arimaerror <-data.frame(fc_result_arimasarima(3,6,1,1,8,0,1,2,1,1)) %>% filter(row_number()%%2 ==0)
WARUK_arimaerror<-txtRound(WARUK_arimaerror[,-1],2)
WARUK_arimaerror <- data.frame(forecast_period=fc_timestamp_out,WARUK_arimaerror)
htmlTable(WARUK_arimaerror)
| forecast_period | MASE.Arima | MASE.Sarima | |
|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 1.20 | 0.96 |
| 2 | 3m_Nov-Jan_out | 1.20 | 1.07 |
| 3 | 3m_Dec-Feb_out | 1.45 | 1.24 |
| 4 | 3m_Jan-Mar_out | 1.85 | 1.58 |
| 5 | 3m_Feb-Apr_out | 1.11 | 0.92 |
| 6 | 1m_Nov_out | 1.01 | 0.70 |
| 7 | 1m_Dec_out | 1.02 | 1.21 |
| 8 | 1m_Jan_out | 1.51 | 1.26 |
| 9 | 1m_Feb_out | 0.44 | 0.38 |
| 10 | 1m_Mar_out | 1.02 | 0.89 |
| 11 | 1m_Apr_out | 0.76 | 0.55 |
Observations
fc_result_across2(3,6,1,1,8,0,1,2,1,1)
## $MAE
## forecast_period ses holt hw_add hw_mul Arima Sarima
## 1 6m_Nov-Apr_in 28.82098 28.79836 19.16986 19.36768 20.70676 15.84349
## 2 6m_Nov-Apr_out 29.13186 28.22814 20.94382 21.78586 26.52724 21.29873
## 3 3m_Nov-Jan_in 28.82098 28.79836 19.16986 19.36768 20.70676 15.84349
## 4 3m_Nov-Jan_out 33.14034 31.89648 23.93825 25.33373 27.87766 25.02444
## 5 3m_Dec-Feb_in 28.91952 28.90371 19.09842 19.28285 20.67735 15.88532
## 6 3m_Dec-Feb_out 30.47796 29.87686 23.55038 23.37988 27.62729 23.60316
## 7 3m_Jan-Mar_in 28.77723 28.70823 19.31966 19.52529 20.61937 16.08653
## 8 3m_Jan-Mar_out 28.96293 31.91232 30.96454 24.38654 37.18457 25.68798
## 9 3m_Feb-Apr_in 28.64621 28.54008 19.02623 19.36195 20.27470 15.92285
## 10 3m_Feb-Apr_out 27.11680 27.87490 17.72514 19.19334 23.33238 19.40728
## 11 1m_Nov_in 28.82098 28.79836 19.16986 19.36768 20.70676 15.84349
## 12 1m_Nov_out 30.12265 29.93947 19.17861 18.43681 27.26544 18.68239
## 13 1m_Dec_in 28.91952 28.90371 19.09842 19.28285 20.67735 15.88532
## 14 1m_Dec_out 31.30868 30.63154 30.23650 30.10730 26.51127 31.23456
## 15 1m_Jan_in 28.77723 28.70823 19.31966 19.52529 20.61937 16.08653
## 16 1m_Jan_out 26.23703 25.05556 21.53150 19.87277 26.10291 21.75883
## 17 1m_Feb_in 28.89159 28.54008 19.02623 19.35917 20.27470 15.92285
## 18 1m_Feb_out 25.39501 27.76141 16.25180 17.38830 20.49617 17.85865
## 19 1m_Mar_in 28.55806 28.45956 19.04268 19.30929 20.28507 15.95166
## 20 1m_Mar_out 23.27438 23.27199 15.59887 15.90344 18.25195 16.00217
## 21 1m_Apr_in 28.29187 28.20198 18.85216 19.13959 20.12943 15.86604
## 22 1m_Apr_out 27.20959 27.45437 17.78947 17.83321 23.82032 17.38110
##
## $MAPE
## forecast_period ses holt hw_add hw_mul Arima
## 1 6m_Nov-Apr_in 0.5909103 0.5821914 0.3505977 0.3553212 0.3703259
## 2 6m_Nov-Apr_out 0.9553429 0.8959336 0.5997629 0.6848645 0.7230100
## 3 3m_Nov-Jan_in 0.5909103 0.5821914 0.3505977 0.3553212 0.3703259
## 4 3m_Nov-Jan_out 1.2042130 1.1336424 0.8104840 0.9187168 0.8772148
## 5 3m_Dec-Feb_in 0.6010551 0.5917624 0.3515533 0.3578109 0.3822292
## 6 3m_Dec-Feb_out 1.0926923 1.0544110 0.8333053 0.8281398 0.9418174
## 7 3m_Jan-Mar_in 0.6208548 0.6078258 0.3814761 0.3877467 0.3864812
## 8 3m_Jan-Mar_out 0.5738793 0.5461635 0.5191572 0.4169745 0.5293566
## 9 3m_Feb-Apr_in 0.6265531 0.6119436 0.3763300 0.3857044 0.3824043
## 10 3m_Feb-Apr_out 0.5314595 0.5255231 0.3558995 0.3592458 0.4917265
## 11 1m_Nov_in 0.5909103 0.5821914 0.3505977 0.3553212 0.3703259
## 12 1m_Nov_out 0.7882818 0.7553887 0.3820458 0.4285194 0.5532158
## 13 1m_Dec_in 0.6010551 0.5917624 0.3515533 0.3578109 0.3822292
## 14 1m_Dec_out 1.2925213 1.2530115 1.2707635 1.2717348 1.0892604
## 15 1m_Jan_in 0.6208548 0.6078258 0.3814761 0.3877467 0.3864812
## 16 1m_Jan_out 0.7778604 0.6536619 0.4571971 0.4746228 0.4777408
## 17 1m_Feb_in 0.5640120 0.6119436 0.3763300 0.3856014 0.3824043
## 18 1m_Feb_out 0.4730915 0.4712047 0.2449163 0.2507572 0.3413123
## 19 1m_Mar_in 0.6216608 0.6096108 0.3745319 0.3815645 0.3804409
## 20 1m_Mar_out 0.4550559 0.4559024 0.2468240 0.2447211 0.2917256
## 21 1m_Apr_in 0.6148704 0.6046627 0.3689643 0.3752048 0.3853128
## 22 1m_Apr_out 0.9348579 0.9482544 0.6148652 0.6452088 0.7483806
## Sarima
## 1 0.2875175
## 2 0.6557749
## 3 0.2875175
## 4 0.8917202
## 5 0.2890496
## 6 0.8286613
## 7 0.3058562
## 8 0.4002496
## 9 0.3037107
## 10 0.3589227
## 11 0.2875175
## 12 0.4104857
## 13 0.2890496
## 14 1.3064874
## 15 0.3058562
## 16 0.4729108
## 17 0.3037107
## 18 0.2609324
## 19 0.3022490
## 20 0.2317217
## 21 0.3034632
## 22 0.5815646
##
## $MASE
## forecast_period ses holt hw_add
## 1 6m_Nov-Apr_in NaN NaN NaN
## 2 6m_Nov-Apr_out 1.3126381075586 1.27191747493191 0.943697112193449
## 3 3m_Nov-Jan_in NaN NaN NaN
## 4 3m_Nov-Jan_out 1.42074162101984 1.36741660311895 1.02624367542471
## 5 3m_Dec-Feb_in NaN NaN NaN
## 6 3m_Dec-Feb_out 1.60504186201305 1.57338646187902 1.24021917817597
## 7 3m_Jan-Mar_in NaN NaN NaN
## 8 3m_Jan-Mar_out 1.78294381881824 1.96450677908921 1.90616194938938
## 9 3m_Feb-Apr_in NaN NaN NaN
## 10 3m_Feb-Apr_out 1.2898960615447 1.32595706973114 0.843151851359788
## 11 1m_Nov_in NaN NaN NaN
## 12 1m_Nov_out 1.12119051317152 1.11437240413335 0.71384406279644
## 13 1m_Dec_in NaN NaN NaN
## 14 1m_Dec_out 1.20867897915411 1.18253756938824 1.16728704340749
## 15 1m_Jan_in NaN NaN NaN
## 16 1m_Jan_out 1.51461459948899 1.4464104266271 1.24297305019322
## 17 1m_Feb_in NaN NaN NaN
## 18 1m_Feb_out 0.539909198327349 0.590219869373757 0.34552033919289
## 19 1m_Mar_in NaN NaN NaN
## 20 1m_Mar_out 1.29767225528038 1.29753915255108 0.869721349584206
## 21 1m_Apr_in NaN NaN NaN
## 22 1m_Apr_out 0.862883557035178 0.870646128538007 0.564148231682622
## hw_mul Arima Sarima
## 1 NaN NaN NaN
## 2 0.981638060456886 1.19527754309856 0.959688942439446
## 3 NaN NaN NaN
## 4 1.08606865222246 1.19512784390653 1.07280898867372
## 5 NaN NaN NaN
## 6 1.23123977404581 1.45491867240685 1.24299822402762
## 7 NaN NaN NaN
## 8 1.50122333299401 1.85305151574134 1.58133921290795
## 9 NaN NaN NaN
## 10 0.912991470803143 1.10987817186834 0.923168199447218
## 11 NaN NaN NaN
## 12 0.686233451964408 1.01484252776394 0.695374142575834
## 13 NaN NaN NaN
## 14 1.16229916161656 1.02347369064707 1.20581754966476
## 15 NaN NaN NaN
## 16 1.14721773195554 1.50687212146416 1.25609650300468
## 17 NaN NaN NaN
## 18 0.369682990947948 0.435757623412606 0.379682774598811
## 19 NaN NaN NaN
## 20 0.88670257462673 1.0176449326799 0.892207532174453
## 21 NaN NaN NaN
## 22 0.565535116533899 0.755401242935939 0.551197655068417
Observations
# holt winter forecast function
fc_hw_loop <- function(traintime1,traintime2,hotel_no,testtime1,testtime2,season) {
# create holt-winters forecast function
fc_hw<- function(traintime1,traintime2,hotel_no,testtime1,testtime2,season) {
k = abs(as.numeric(difftime(traintime1, traintime2, unit = "day"))) + 1
k1= abs(as.numeric(difftime(testtime1, testtime2, unit = "day"))) + 1
training_ts <- subset(smoothing_dataset_ts,end=k)
fc_ts<- hw(training_ts[,hotel_no],h=k1,seasonal=season,damped = TRUE)
return(fc_ts)
}
# Initiate rolling forecast
fcday1 <-fc_hw(traintime1,traintime2, hotel_no ,testtime1,testtime2, season)
fc <- data.frame(forecast = as.numeric(fcday1$mean),stay_date = (seq(as.Date(testtime1), as.Date(testtime2),by="day")),CONF_DT=as.Date(traintime2) )
# create loop and forecast
for (delta in 1: (as.numeric(difftime(testtime2, testtime1, unit = "day"))-1)) {
hwtest <- fc_hw(as.Date(traintime1), as.Date(traintime2) + delta,hotel_no,as.Date(testtime1) + delta, as.Date(testtime2), season)
hwtest_mean <- data.frame(forecast=as.numeric(hwtest$mean),stay_date = (seq(as.Date(testtime1) + delta, as.Date(testtime2),by="day")),CONF_DT=as.Date(traintime2) + delta)
fc <- rbind(fc, hwtest_mean)
}
fc<- fc %>% mutate(days_prior = stay_date-CONF_DT,hotel=ifelse(hotel_no == 1 ,"GLWST",
ifelse(hotel_no == 2,"MLKEP","WARUK")))
return(fc)
}
# holt winter forecast function
fc_hw_daysprior <- function(hotel_no,season) {
# hw_add
# six-month forecasting errors
six_month_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30",season)
fc1 <- data.frame(forecast = as.numeric(six_month_hw$mean),stay_date = (seq(as.Date("2009-11-01"), as.Date("2010-04-30"),by="day")),CONF_DT=as.Date("2009-10-31"),forecast_period= "6m_Nov-Apr_out")
# three-month forecasting errors
three_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31", season)
fc2 <- data.frame(forecast = as.numeric(three_month_1_hw$mean),stay_date = (seq(as.Date("2009-11-01"), as.Date("2010-01-31",),by="day")),CONF_DT=as.Date("2009-10-31"),forecast_period= "3m_Nov-Jan_out" )
three_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28", season)
fc3 <- data.frame(forecast = as.numeric(three_month_2_hw$mean),stay_date = (seq(as.Date("2009-12-01"), as.Date("2010-02-28",),by="day")),CONF_DT=as.Date("2009-11-30"),forecast_period= "3m_Dec-Feb_out" )
three_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31", season)
fc4 <- data.frame(forecast = as.numeric(three_month_3_hw$mean),stay_date = (seq(as.Date("2010-01-01"), as.Date("2010-03-31",),by="day")),CONF_DT=as.Date("2009-12-31"),forecast_period= "3m_Jan-Mar_out" )
three_month_4_hw <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30", season)
fc5 <- data.frame(forecast = as.numeric(three_month_4_hw$mean),stay_date = (seq(as.Date("2010-02-01"), as.Date("2010-04-30"),by="day")),CONF_DT=as.Date("2010-01-31"),forecast_period= "3m_Feb-Apr_out" )
# one-month forecasting errors
one_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30", season)
fc6 <- data.frame(forecast = as.numeric(one_month_1_hw$mean),stay_date = (seq(as.Date("2009-11-01"), as.Date("2009-11-30"),by="day")),CONF_DT=as.Date("2009-10-31"),forecast_period= "1m_Nov_out" )
one_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31", season)
fc7 <- data.frame(forecast = as.numeric(one_month_2_hw$mean),stay_date = (seq(as.Date("2009-12-01"), as.Date("2009-12-31"),by="day")),CONF_DT=as.Date("2009-11-30"),forecast_period= "1m_Dec_out" )
one_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31", season)
fc8 <- data.frame(forecast = as.numeric(one_month_3_hw$mean),stay_date = (seq(as.Date("2010-01-01"), as.Date("2010-01-31"),by="day")),CONF_DT=as.Date("2009-12-31"),forecast_period= "1m_Jan_out" )
one_month_4_hw <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28", season)
fc9 <- data.frame(forecast = as.numeric(one_month_4_hw$mean),stay_date = (seq(as.Date("2010-02-01"), as.Date("2010-02-28"),by="day")),CONF_DT=as.Date("2010-01-31"),forecast_period= "1m_Feb_out" )
one_month_5_hw <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31", season)
fc10 <- data.frame(forecast = as.numeric(one_month_5_hw$mean),stay_date = (seq(as.Date("2010-03-01"), as.Date("2010-03-31"),by="day")),CONF_DT=as.Date("2010-02-28"),forecast_period= "1m_Mar_out" )
one_month_6_hw <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30", season)
fc11 <- data.frame(forecast = as.numeric(one_month_6_hw$mean),stay_date = (seq(as.Date("2010-04-01"), as.Date("2010-04-30"),by="day")),CONF_DT=as.Date("2010-03-31"),forecast_period= "1m_Apr_out" )
# merge data
result <- rbind(fc1,fc2,fc3,fc4,fc5,fc6,fc7,fc8,fc9,fc10,fc11)
result <- result %>% mutate(hotel=ifelse(hotel_no == 1 ,"GLWST",
ifelse(hotel_no == 2,"MLKEP","WARUK")))
return(result)
}
fc_combined_weight<- function(dataset,hotel_name,model1,model2,factor) {
if(factor == "days_prior_c") {
# days prior '1-7'
hotel_dataset1 <- dataset %>%
filter(hotel == hotel_name,days_prior_c == '1 to 7')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod1 <- lm(formula,data = hotel_dataset1 )
hotel_dataset1 <- hotel_dataset1 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod1$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod1$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod1$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod1$coefficients[3])
# days prior '8-14'
hotel_dataset2 <- dataset %>%
filter(hotel == hotel_name,days_prior_c == '8 to 14')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = "+"),
sep = " ~ "))
linearMod2 <- lm(formula,data = hotel_dataset2 )
hotel_dataset2 <- hotel_dataset2 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod2$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod2$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod2$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod2$coefficients[3])
# days prior '15-21'
hotel_dataset3 <- dataset %>%
filter(hotel == hotel_name,days_prior_c == '15 to 21')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod3 <- lm(formula,data = hotel_dataset3 )
hotel_dataset3 <- hotel_dataset3 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod3$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod3$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod3$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod3$coefficients[3])
# days prior '22-28'
hotel_dataset4 <- dataset %>%
filter(hotel == hotel_name,days_prior_c == '22 to 28')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod4 <- lm(formula,data = hotel_dataset4 )
hotel_dataset4 <- hotel_dataset4 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod4$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod4$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod4$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod4$coefficients[3])
# days prior '29-60'
hotel_dataset5 <- dataset %>%
filter(hotel == hotel_name,days_prior_c == '29 to 60')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod5 <- lm(formula,data = hotel_dataset5 )
hotel_dataset5 <- hotel_dataset5 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod5$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod5$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod5$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod5$coefficients[3])
# days prior '60 or more'
hotel_dataset6 <- dataset %>%
filter(hotel == hotel_name,days_prior_c == '60 or more')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod6 <- lm(formula,data = hotel_dataset6 )
hotel_dataset6 <- hotel_dataset6 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod6$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod6$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod6$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod6$coefficients[3])
hotel_dataset<-rbind(hotel_dataset1,hotel_dataset2,hotel_dataset3,hotel_dataset4,hotel_dataset5,hotel_dataset6)
result <- list('1 to 7'=linearMod1,'8 to 14'=linearMod2,'15 to 21'= linearMod3,'22 to 28'=linearMod4,
'29 to 60'= linearMod5,'60 or more'= linearMod6,dataset=hotel_dataset)
} else {
# DOW 'Sun'
hotel_dataset1 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Sun')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod1 <- lm(formula,data = hotel_dataset1 )
hotel_dataset1 <- hotel_dataset1 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod1$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod1$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod1$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod1$coefficients[3])
# DOW 'Mon'
hotel_dataset2 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Mon')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = "+"),
sep = " ~ "))
linearMod2 <- lm(formula,data = hotel_dataset2 )
hotel_dataset2 <- hotel_dataset2 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod2$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod2$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod2$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod2$coefficients[3])
# DOW 'Tue'
hotel_dataset3 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Tue')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod3 <- lm(formula,data = hotel_dataset3 )
hotel_dataset3 <- hotel_dataset3 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod3$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod3$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod3$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod3$coefficients[3])
# DOW 'Wed'
hotel_dataset4 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Wed')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod4 <- lm(formula,data = hotel_dataset4 )
hotel_dataset4 <- hotel_dataset4 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod4$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod4$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod4$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod4$coefficients[3])
# DOW 'Thu'
hotel_dataset5 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Thu')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod5 <- lm(formula,data = hotel_dataset5 )
hotel_dataset5 <- hotel_dataset5 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod5$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod5$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod5$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod5$coefficients[3])
# DOW 'Fri'
hotel_dataset6 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Fri')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod6 <- lm(formula,data = hotel_dataset6 )
hotel_dataset6 <- hotel_dataset6 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod6$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod6$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod6$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod6$coefficients[3])
# DOW 'Sat'
hotel_dataset7 <- dataset %>%
filter(hotel == hotel_name,DOW == 'Sat')
formula <- as.formula(
paste("final_arrivals",
paste(c(model1,model2), collapse = " + "),
sep = " ~ "))
linearMod7 <- lm(formula,data = hotel_dataset7 )
hotel_dataset7 <- hotel_dataset7 %>%
mutate(!!paste(c(model1,model2),collapse = ".") := linearMod7$fitted.values,
!!paste(c("interc",model1,model2),collapse = ".") :=linearMod6$coefficients[1],
!!paste(c("coef1",model1,model2),collapse = ".") := linearMod6$coefficients[2],
!!paste(c("coef2",model1,model2),collapse = ".") := linearMod6$coefficients[3])
hotel_dataset<-rbind(hotel_dataset1,hotel_dataset2,hotel_dataset3,hotel_dataset4,hotel_dataset5,hotel_dataset6,hotel_dataset7)
result<-list('Sun'=linearMod1,'Mon'=linearMod2,'Tue'= linearMod3,'Wed'=linearMod4,
'Thu'= linearMod5,'Fri'= linearMod6,'Sat'= linearMod7,dataset=hotel_dataset) }
return(result)
}
cross_result_error <- function(hotelname,factor) {
cross_result <- function(dataset,hotel_name,model1,model2,factor) {
# run the combined function
fc_combined<-fc_combined_weight(dataset,hotel_name,model1,model2,factor)
dataset <- fc_combined$dataset
dataset_error <- dataset %>%
group_by_(factor) %>%
# MAE error measurements
summarise(MAE_add = sum(abs(fc_add- final_arrivals))/n(),
MAE_mul = sum(abs(fc_mul-final_arrivals))/n(),
MAE_add_mDOW = sum(abs(fc_add_mDOW -final_arrivals))/n(),
!!paste(c("MAE",model1,model2),collapse = "_") := sum(abs(get(paste(c(model1,model2),collapse = ".")) - final_arrivals))/n(),
# MAPE error measurements
MAPE_add = sum(abs(fc_add - final_arrivals)/final_arrivals)/n(),
MAPE_mul = sum(abs(fc_mul - final_arrivals)/final_arrivals)/n(),
MAPE_add_mDOW = sum(abs(fc_add_mDOW - final_arrivals)/final_arrivals)/n(),
!!paste(c("MAPE",model1,model2),collapse = "_") := sum(abs(get(paste(c(model1,model2),collapse = "."))- final_arrivals)/final_arrivals)/n())
return(dataset_error)
}
# fit combined modle1 and get error result
result1 <- cross_result(in_compare_dataset,hotelname,"fc_add","fc_hw_a",factor)
## MAE, MAPE
result1_MAE <- result1[names(result1) %like% "MAE" | names(result1) == factor]
result1_MAPE <- result1[names(result1) %like% "MAPE" | names(result1) == factor]
# fit combined modle2 and get error result
result2 <- cross_result(in_compare_dataset,hotelname,"fc_add","fc_hw_m",factor)
## MAE, MAPE errors
result2_MAE <- result2[,ncol(result2)-4]
result2_MAPE <-result2[,ncol(result2)]
# fit combined modle3 and get error result
result3 <- cross_result(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_a",factor)
## MAE, MAPE errors
result3_MAE <- result3[,ncol(result2)-4]
result3_MAPE <-result3[,ncol(result2)]
# final result
result_MAE <- cbind(result1_MAE,result2_MAE,result3_MAE)
result_MAPE <- cbind(result1_MAPE,result2_MAPE,result3_MAPE)
return(list(result_MAE, result_MAPE))
}
out_compare_dataset <- function(hotelname,factor) {
# fit combined models to get coefficient from training data
fc1<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add","fc_hw_a",factor)
dataset1<-fc1$dataset
fc2<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_a",factor)
dataset2<-fc2$dataset
fc3<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_m",factor)
dataset3<-fc3$dataset
# store the combined model parameters as parameter datasets for later join with out-sample data
coe_fc_add.fc_hw_a <- dataset1[,c(1,which(names(dataset1) == factor),(ncol(dataset1)-2):ncol(dataset1))] %>% distinct()
coe_fc_add_mDOW.fc_hw_a <- dataset2[,c(1,which(names(dataset2) == factor),(ncol(dataset2)-2):ncol(dataset2))] %>% distinct()
coe_fc_add_mDOW.fc_hw_m <- dataset3[,c(1,which(names(dataset3) == factor),(ncol(dataset3)-2):ncol(dataset3))] %>% distinct()
# get out-sample forecast data using hw_additive and hw multiplicative model
if(hotelname == "GLWST") {
hotelno<-1
} else if (hotelname == "MLKEP") {
hotelno<-2
} else {
hotelno<-3}
# result from the best model from ets method
result_hw_a<-fc_hw_daysprior(hotelno,"additive") %>% rename(fc_hw_a=forecast)
result_hw_w<-fc_hw_daysprior(hotelno,"multiplicative") %>% rename(fc_hw_m=forecast)
# merge out-sample dataset with the advance booking model
out_compare_dataset<- valid_dataset %>%
select(c("hotel","days_prior_c","month","DOW","days_prior","CONF_DT","stay_date","final_arrivals","fc_naive","fc_add_mDOW","fc_add","fc_mul")) %>%
# merge with the hw_additive and hw_multiplicative forecast data
merge(result_hw_a, by = c("hotel","CONF_DT","stay_date")) %>%
merge(result_hw_w, by = c("hotel","stay_date","CONF_DT","forecast_period")) %>%
# merge with the parameters dataset calculated from in sample dataset
merge(coe_fc_add.fc_hw_a, by = c("hotel",factor)) %>%
merge(coe_fc_add_mDOW.fc_hw_a, by = c("hotel",factor)) %>%
merge(coe_fc_add_mDOW.fc_hw_m, by = c("hotel",factor)) %>%
filter(days_prior!=0) %>% # filter out final_day forecast
# model combined fc_add and fc_hw_a
mutate(fc_add.fc_hw_a = interc.fc_add.fc_hw_a + coef1.fc_add.fc_hw_a*fc_add + coef2.fc_add.fc_hw_a*fc_hw_a ) %>%
# model combined fc_mDOW and fc_hw_a
mutate(fc_add_mDOW.fc_hw_a = interc.fc_add_mDOW.fc_hw_a + coef1.fc_add_mDOW.fc_hw_a*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_a *fc_hw_a ) %>%
# model combined fc_mDOW and fc_hw_m
mutate(fc_add_mDOW.fc_hw_m = interc.fc_add_mDOW.fc_hw_m + coef1.fc_add_mDOW.fc_hw_m*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_m *fc_hw_m ) %>% select(-(16:24)) # drop columns with the coefficient datas
# drop NA rows from the out compare dataset
out_compare_dataset <- na.omit(out_compare_dataset)
return(out_compare_dataset)
}
out_crosss_result_error <- function(hotelname,factor) {
result_hotel <- out_compare_dataset(hotelname,factor) %>%
group_by(forecast_period,hotel) %>%
# MAE error measurements
summarise(MAE_naive = sum(abs(fc_naive- final_arrivals))/n(),
MAE_add = sum(abs(fc_add- final_arrivals))/n(),
MAE_mul = sum(abs(fc_mul-final_arrivals))/n(),
MAE_add_mDOW = sum(abs(fc_add_mDOW-final_arrivals))/n(),
MAE_fc_add.fc_hw_a = sum(abs(fc_add.fc_hw_a-final_arrivals))/n(),
MAE_fc_add_mDOW.fc_hw_a = sum(abs(fc_add_mDOW.fc_hw_a-final_arrivals))/n(),
MAE_fc_add_mDOW.fc_hw_m = sum(abs(fc_add_mDOW.fc_hw_m-final_arrivals))/n(),
# MAPE error measurements
MAPE_add = sum(abs(fc_add - final_arrivals)/final_arrivals)/n(),
MAPE_mul = sum(abs(fc_mul - final_arrivals)/final_arrivals)/n(),
MAPE_add_mDOW = sum(abs(fc_add_mDOW - final_arrivals)/final_arrivals)/n(),
MAPE_fc_add.fc_hw_a = sum(abs(fc_add.fc_hw_a-final_arrivals)/final_arrivals)/n(),
MAPE_fc_add_mDOW.fc_hw_a = sum(abs(fc_add_mDOW.fc_hw_a-final_arrivals)/final_arrivals)/n(),
MAPE_fc_add_mDOW.fc_hw_m = sum(abs(fc_add_mDOW.fc_hw_m-final_arrivals)/final_arrivals)/n(),
# MASE error measurements compared to naive model
MASE_add = MAE_add/MAE_naive,
MASE_mul = MAE_mul/MAE_naive,
MASE_add_mDOW = MAE_add_mDOW/MAE_naive,
MASE_fc_add.fc_hw_a = MAE_fc_add.fc_hw_a/MAE_naive,
MASE_fc_add_mDOW.fc_hw_a = MAE_fc_add_mDOW.fc_hw_a/MAE_naive,
MASE_fc_add_mDOW.fc_hw_m = MAE_fc_add_mDOW.fc_hw_m/MAE_naive)
result_MAE <- result_hotel[names(result_hotel) %like% "MAE" | names(result_hotel) == "forecast_period"]
result_MAPE <- result_hotel[names(result_hotel) %like% "MAPE" | names(result_hotel) == "forecast_period"]
result_MASE <- result_hotel[names(result_hotel) %like% "MASE" | names(result_hotel) == "forecast_period"]
return(list(result_MAE,result_MAPE,result_MASE))
}
# initiate the forecast from the least time range for damp and seasonal forecast using hw_add
result_hw_a_1<-fc_hw_loop("2008-05-01","2008-05-17",1,"2008-05-18","2009-07-31", "additive")
result_hw_a_2<-fc_hw_loop("2008-05-01","2008-05-17",2,"2008-05-18","2009-07-31", "additive")
result_hw_a_3<-fc_hw_loop("2008-05-01","2008-05-17",3,"2008-05-18","2009-07-31", "additive")
result_hw_a_daysprior = rbind(result_hw_a_1,result_hw_a_2,result_hw_a_3) %>% rename(fc_hw_a = forecast)
# initiate the forecast from the least time range for damp and seasonal forecast using hw_mul
result_hw_m_1<-fc_hw_loop("2008-05-01","2008-05-17",1,"2008-05-18","2009-07-31", "multiplicative")
result_hw_m_2<-fc_hw_loop("2008-05-01","2008-05-17",2,"2008-05-18","2009-07-31", "multiplicative")
result_hw_m_3<-fc_hw_loop("2008-05-01","2008-05-17",3,"2008-05-18","2009-07-31", "multiplicative")
result_hw_m_daysprior = rbind(result_hw_m_1,result_hw_m_2,result_hw_m_3) %>% rename(fc_hw_m = forecast)
# merged with the in-sample dataset from the advance booking model
in_compare_dataset<- training_dataset %>%
select(c("hotel","days_prior_c","DOW","days_prior","CONF_DT","stay_date","final_arrivals","fc_add_mDOW","fc_add","fc_mul")) %>%
merge(result_hw_a_daysprior, by=c("hotel","CONF_DT","stay_date","days_prior")) %>%
merge(result_hw_m_daysprior, by=c("hotel","CONF_DT","stay_date","days_prior")) %>%
filter(days_prior!=0) # filter out final_day forecast
# by days prior category
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add","fc_hw_a","days_prior_c")
weight1 <- list.remove(fc1,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 0.3485 0.8114 0.1830
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 6.4373 0.6911 0.2437
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 2.7314 0.6713 0.3002
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 7.7915 0.6668 0.2559
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 15.1555 0.7003 0.1534
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 37.54891 0.61860 0.05243
#fc1$dataset
## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_a","days_prior_c")
weight2 <- list.remove(fc2,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 2.8148 0.8562 0.1154
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 10.56695 0.80970 0.08643
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 9.3582 0.8027 0.1056
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 13.13990 0.79155 0.08046
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 14.31468 0.83483 0.02873
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 20.07251 0.85079 -0.02438
#fc3$dataset
## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_m","days_prior_c")
weight3 <- list.remove(fc3,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 2.6859 0.8565 0.1161
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 10.16474 0.80783 0.09202
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 9.3273 0.8022 0.1062
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 13.67648 0.79383 0.07281
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 14.12744 0.83407 0.03122
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 19.5327 0.8503 -0.0184
#fc4$dataset
# by DOW
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add","fc_hw_a","DOW")
weight1 <- list.remove(fc1,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -16.5531 1.1405 -0.1397
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 25.24525 0.80229 -0.04772
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 51.28800 0.53534 0.02723
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 29.69969 0.72667 0.06083
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 13.6350 0.8748 -0.0215
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 56.1548 0.5530 -0.0636
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 91.52717 0.28321 -0.02527
#fc1$dataset
## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_a","DOW")
weight2 <- list.remove(fc2,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 4.1771 1.0849 -0.1296
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 18.94484 0.87359 -0.05219
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 25.30640 0.73601 0.03736
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 9.76577 0.88114 0.03824
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 10.815056 0.908693 -0.006085
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 32.52800 0.73212 -0.01506
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 64.35856 0.47981 -0.01355
#fc2$dataset
## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_m","DOW")
weight3 <- list.remove(fc3,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 7.1011 1.0874 -0.1643
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 19.72180 0.87492 -0.06159
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 24.66845 0.73527 0.04454
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 9.95366 0.88047 0.03726
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 11.067785 0.909007 -0.008882
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 32.04112 0.73218 -0.01013
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 63.490702 0.479645 -0.005691
#fc3$dataset
Observations
# by days prior category
cross_result_error("GLWST","days_prior_c")
## [[1]]
## days_prior_c MAE_add MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a
## 1 1 to 7 9.28015 13.07666 7.795196 8.500324
## 2 15 to 21 15.94117 32.56143 12.610089 14.188762
## 3 22 to 28 16.92594 38.99523 13.395501 15.380978
## 4 29 to 60 18.35714 54.02179 13.785932 17.541774
## 5 60 or more 18.04491 83.25584 12.331291 17.069991
## 6 8 to 14 14.72105 26.58511 11.637384 13.007178
## MAE_fc_add_fc_hw_m MAE_fc_add_mDOW_fc_hw_a
## 1 8.533622 7.39985
## 2 14.237039 12.15145
## 3 15.457630 13.06441
## 4 17.515387 13.69863
## 5 17.046116 12.16209
## 6 13.027216 11.13242
##
## [[2]]
## days_prior_c MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 1 to 7 0.1029720 0.1241249 0.08474013 0.1026526
## 2 15 to 21 0.1918225 0.3056005 0.14554752 0.1843609
## 3 22 to 28 0.2088548 0.3656297 0.15561768 0.2045567
## 4 29 to 60 0.2335163 0.4926554 0.16356515 0.2334446
## 5 60 or more 0.2065710 0.7359417 0.13698673 0.2059333
## 6 8 to 14 0.1697515 0.2480218 0.13146077 0.1652238
## MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1 0.1030759 0.08735447
## 2 0.1850688 0.15062517
## 3 0.2056021 0.16327511
## 4 0.2332478 0.17110592
## 5 0.2056922 0.14180403
## 6 0.1653377 0.13640385
# by day of week
cross_result_error("GLWST","DOW")
## [[1]]
## DOW MAE_add MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a MAE_fc_add_fc_hw_m
## 1 Sun 20.59738 52.16970 13.15957 17.097667 17.052245
## 2 Mon 16.42928 62.30680 14.20646 16.332925 16.327319
## 3 Tue 20.19633 76.27306 13.87837 17.145271 17.142709
## 4 Wed 18.21223 60.87822 12.71926 15.415175 15.407881
## 5 Thu 14.69321 51.86594 12.09776 14.652481 14.652644
## 6 Fri 14.15600 65.50156 10.91984 12.430955 12.433630
## 7 Sat 17.12483 82.95807 10.66083 8.897673 8.892612
## MAE_fc_add_mDOW_fc_hw_a
## 1 13.110481
## 2 14.013861
## 3 13.824165
## 4 12.472228
## 5 11.984279
## 6 10.038697
## 7 8.201391
##
## [[2]]
## DOW MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 Sun 0.3071788 0.5248007 0.17113137 0.22522494
## 2 Mon 0.1839454 0.5995409 0.15389903 0.18746999
## 3 Tue 0.2311120 0.6657121 0.15296971 0.22912056
## 4 Wed 0.2150265 0.5322133 0.15892275 0.21288589
## 5 Thu 0.1979840 0.4882001 0.14989666 0.19745605
## 6 Fri 0.1507253 0.5703135 0.11136302 0.14238788
## 7 Sat 0.1544787 0.6719462 0.09951052 0.09829037
## MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1 0.22483214 0.17000871
## 2 0.18741667 0.15720588
## 3 0.22913323 0.16943869
## 4 0.21283586 0.16324700
## 5 0.19743627 0.15391257
## 6 0.14245639 0.11088827
## 7 0.09826932 0.08752955
# by days prior category
G_outdata_dpr <-out_compare_dataset("GLWST","days_prior_c")
head(G_outdata_dpr)
## hotel days_prior_c stay_date CONF_DT forecast_period month DOW
## 1 GLWST 1 to 7 2009-11-01 2009-10-31 1m_Nov_out 11 Sun
## 2 GLWST 1 to 7 2009-11-01 2009-10-31 3m_Nov-Jan_out 11 Sun
## 3 GLWST 1 to 7 2009-11-01 2009-10-31 6m_Nov-Apr_out 11 Sun
## 4 GLWST 1 to 7 2009-11-02 2009-10-31 1m_Nov_out 11 Mon
## 5 GLWST 1 to 7 2009-11-02 2009-10-31 3m_Nov-Jan_out 11 Mon
## 6 GLWST 1 to 7 2009-11-02 2009-10-31 6m_Nov-Apr_out 11 Mon
## days_prior final_arrivals fc_naive fc_add_mDOW fc_add fc_mul
## 1 1 87 57 88.60 89.87978 89.12279
## 2 1 87 57 88.60 89.87978 89.12279
## 3 1 87 57 88.60 89.87978 89.12279
## 4 2 111 81 100.25 106.27687 106.93273
## 5 2 111 81 100.25 106.27687 106.93273
## 6 2 111 81 100.25 106.27687 106.93273
## fc_hw_a fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1 88.58456 90.4744 89.49435 88.8985
## 2 88.58456 90.4744 89.49435 88.8985
## 3 88.58456 90.4744 89.49435 88.8985
## 4 101.69017 102.9735 105.19834 100.3858
## 5 101.69017 102.9735 105.19834 100.3858
## 6 101.69017 102.9735 105.19834 100.3858
## fc_add_mDOW.fc_hw_m
## 1 89.08029
## 2 89.08029
## 3 89.08029
## 4 100.51026
## 5 100.51026
## 6 100.51026
nrow(G_outdata_dpr)
## [1] 652
# by DOW
G_outdata_DOW <-out_compare_dataset("GLWST","DOW")
head(G_outdata_DOW)
## hotel DOW stay_date CONF_DT forecast_period days_prior_c month
## 1 GLWST Fri 2009-11-06 2009-10-31 6m_Nov-Apr_out 1 to 7 11
## 2 GLWST Fri 2009-11-06 2009-10-31 3m_Nov-Jan_out 1 to 7 11
## 3 GLWST Fri 2010-02-26 2010-01-31 1m_Feb_out 22 to 28 2
## 4 GLWST Fri 2010-04-16 2010-03-31 1m_Apr_out 15 to 21 4
## 5 GLWST Fri 2010-01-01 2009-10-31 6m_Nov-Apr_out 60 or more 1
## 6 GLWST Fri 2009-12-04 2009-10-31 3m_Nov-Jan_out 29 to 60 12
## days_prior final_arrivals fc_naive fc_add_mDOW fc_add fc_mul
## 1 6 125 80 132.50 135.04007 152.12844
## 2 6 125 80 132.50 135.04007 152.12844
## 3 26 100 114 117.25 105.76685 109.93741
## 4 16 105 127 91.75 94.40619 82.71067
## 5 62 66 59 89.20 107.30612 119.39269
## 6 34 125 118 120.50 140.31752 249.33076
## fc_hw_a fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1 111.94086 110.59625 123.7168 127.84771
## 2 111.94086 110.59625 123.7168 127.84771
## 3 82.54776 78.38306 109.3972 117.12564
## 4 123.74049 124.95882 100.4943 97.83606
## 5 111.92214 110.58524 108.3801 96.14718
## 6 111.92892 110.58817 126.6361 119.06245
## fc_add_mDOW.fc_hw_m
## 1 127.93425
## 2 127.93425
## 3 117.09486
## 4 97.95257
## 5 96.23111
## 6 119.14821
nrow(G_outdata_DOW)
## [1] 652
# by days prior category
out_crosss_result_error("GLWST","days_prior_c")
## [[1]]
## # A tibble: 11 x 8
## # Groups: forecast_period [11]
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 17.9 21.9 49.3 17.3 22.1
## 2 3m_Nov-Jan_out 18.6 24.8 37.0 18.1 25.3
## 3 3m_Dec-Feb_out 16.9 22.7 37.3 15.8 24.9
## 4 3m_Jan-Mar_out 16.7 16.8 46.0 13.9 19.1
## 5 3m_Feb-Apr_out 21.0 14.5 40.1 14.7 15.0
## 6 1m_Nov_out 17.3 13.4 31.6 14.5 11.3
## 7 1m_Dec_out 21.4 15.4 25.2 13.4 17.2
## 8 1m_Jan_out 15.7 14.1 27.5 11.9 19.9
## 9 1m_Feb_out 13.2 11.4 24.1 11.3 10.9
## 10 1m_Mar_out 26.9 12.5 25.3 11.1 12.4
## 11 1m_Apr_out 22.2 13.1 34.7 10.5 12.4
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[2]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 0.374 0.520 0.269 0.393
## 2 3m_Nov-Jan_out 0.478 0.428 0.317 0.505
## 3 3m_Dec-Feb_out 0.440 0.476 0.278 0.494
## 4 3m_Jan-Mar_out 0.243 0.548 0.193 0.300
## 5 3m_Feb-Apr_out 0.178 0.436 0.183 0.184
## 6 1m_Nov_out 0.138 0.301 0.139 0.119
## 7 1m_Dec_out 0.378 0.337 0.281 0.442
## 8 1m_Jan_out 0.271 0.418 0.192 0.396
## 9 1m_Feb_out 0.137 0.263 0.133 0.129
## 10 1m_Mar_out 0.133 0.274 0.128 0.135
## 11 1m_Apr_out 0.143 0.387 0.116 0.150
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAPE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[3]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.22 2.76 0.966 1.24
## 2 3m_Nov-Jan_out 1.33 1.98 0.973 1.36
## 3 3m_Dec-Feb_out 1.34 2.21 0.934 1.47
## 4 3m_Jan-Mar_out 1.01 2.76 0.837 1.15
## 5 3m_Feb-Apr_out 0.689 1.91 0.696 0.711
## 6 1m_Nov_out 0.774 1.82 0.838 0.652
## 7 1m_Dec_out 0.717 1.18 0.625 0.801
## 8 1m_Jan_out 0.894 1.75 0.757 1.26
## 9 1m_Feb_out 0.861 1.82 0.853 0.825
## 10 1m_Mar_out 0.463 0.938 0.414 0.459
## 11 1m_Apr_out 0.588 1.56 0.474 0.557
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## # MASE_fc_add_mDOW.fc_hw_m <dbl>
# by DOW
out_crosss_result_error("GLWST","DOW")
## [[1]]
## # A tibble: 11 x 8
## # Groups: forecast_period [11]
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 17.9 21.9 49.3 17.3 20.7
## 2 3m_Nov-Jan_out 18.6 24.8 37.0 18.1 23.4
## 3 3m_Dec-Feb_out 16.9 22.7 37.3 15.8 24.1
## 4 3m_Jan-Mar_out 16.7 16.8 46.0 13.9 18.7
## 5 3m_Feb-Apr_out 21.0 14.5 40.1 14.7 14.1
## 6 1m_Nov_out 17.3 13.4 31.6 14.5 9.71
## 7 1m_Dec_out 21.4 15.4 25.2 13.4 17.9
## 8 1m_Jan_out 15.7 14.1 27.5 11.9 20.8
## 9 1m_Feb_out 13.2 11.4 24.1 11.3 12.8
## 10 1m_Mar_out 26.9 12.5 25.3 11.1 10.9
## 11 1m_Apr_out 22.2 13.1 34.7 10.5 11.9
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[2]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 0.374 0.520 0.269 0.368
## 2 3m_Nov-Jan_out 0.478 0.428 0.317 0.475
## 3 3m_Dec-Feb_out 0.440 0.476 0.278 0.480
## 4 3m_Jan-Mar_out 0.243 0.548 0.193 0.291
## 5 3m_Feb-Apr_out 0.178 0.436 0.183 0.177
## 6 1m_Nov_out 0.138 0.301 0.139 0.0998
## 7 1m_Dec_out 0.378 0.337 0.281 0.453
## 8 1m_Jan_out 0.271 0.418 0.192 0.417
## 9 1m_Feb_out 0.137 0.263 0.133 0.160
## 10 1m_Mar_out 0.133 0.274 0.128 0.119
## 11 1m_Apr_out 0.143 0.387 0.116 0.130
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAPE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[3]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.22 2.76 0.966 1.16
## 2 3m_Nov-Jan_out 1.33 1.98 0.973 1.25
## 3 3m_Dec-Feb_out 1.34 2.21 0.934 1.43
## 4 3m_Jan-Mar_out 1.01 2.76 0.837 1.12
## 5 3m_Feb-Apr_out 0.689 1.91 0.696 0.671
## 6 1m_Nov_out 0.774 1.82 0.838 0.560
## 7 1m_Dec_out 0.717 1.18 0.625 0.836
## 8 1m_Jan_out 0.894 1.75 0.757 1.32
## 9 1m_Feb_out 0.861 1.82 0.853 0.963
## 10 1m_Mar_out 0.463 0.938 0.414 0.404
## 11 1m_Apr_out 0.588 1.56 0.474 0.535
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## # MASE_fc_add_mDOW.fc_hw_m <dbl>
Observations
# by days prior category
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add","fc_hw_a","days_prior_c")
weight1 <- list.remove(fc1,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -26.8037 1.0524 0.2365
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -60.3307 1.1622 0.4984
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -71.3959 1.2464 0.5455
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -80.1914 1.3254 0.5717
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -93.468 1.421 0.631
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -98.5864 1.6318 0.4851
#fc1$dataset
## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_a","days_prior_c")
weight2 <- list.remove(fc2,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -3.86612 1.00690 0.04047
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -5.40022 1.03469 0.03958
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -4.219190 1.065780 0.001625
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -4.4631 1.0662 0.0102
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -2.52781 1.02414 0.05253
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 7.30964 1.06686 -0.06671
#fc3$dataset
## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_m","days_prior_c")
weight3 <- list.remove(fc3,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -3.371 1.016 0.026
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -5.1735 1.0382 0.0333
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -4.299010 1.063210 0.004978
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -3.99409 1.08042 -0.00899
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -2.15161 1.01960 0.05127
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 6.06617 1.04369 -0.02579
#fc4$dataset
# by DOW
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add","fc_hw_a","DOW")
weight1 <- list.remove(fc1,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -33.805386 0.923631 0.004683
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -28.82048 1.51540 0.02644
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 55.83555 0.76447 0.09117
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 57.4416 0.6702 0.1365
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -53.13372 1.56247 0.02914
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -66.11939 1.41989 -0.05311
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -40.19102 1.44238 -0.05679
#fc1$dataset
## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_a","DOW")
weight2 <- list.remove(fc2,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -4.83220 1.14074 0.03263
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -5.04598 1.07855 0.01967
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -0.47192 0.97195 0.06897
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 2.58293 0.93608 0.08636
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -1.46285 1.07546 -0.01857
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -20.78237 1.41731 0.02061
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -21.90091 1.26506 0.03861
#fc2$dataset
## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_m","DOW")
weight3 <- list.remove(fc3,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -7.5710 1.1379 0.1023
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -7.9545 1.0787 0.0446
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 0.02970 0.97664 0.05706
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 4.49191 0.94708 0.05639
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -3.892182 1.072141 0.009532
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -22.14399 1.41784 0.04569
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -19.73525 1.26638 0.01073
#fc3$dataset
Observations
# by days prior category
cross_result_error("MLKEP","days_prior_c")
## [[1]]
## days_prior_c MAE_add MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a
## 1 1 to 7 15.71757 13.38203 8.97154 12.12138
## 2 15 to 21 35.85519 43.70532 17.69533 26.18290
## 3 22 to 28 37.77129 53.21220 18.70008 27.78223
## 4 29 to 60 40.03824 74.12069 20.21390 29.41933
## 5 60 or more 41.81673 97.18865 19.82303 33.45193
## 6 8 to 14 31.71407 31.76389 15.91995 22.00902
## MAE_fc_add_fc_hw_m MAE_fc_add_mDOW_fc_hw_a
## 1 12.35358 8.888232
## 2 27.85207 17.313990
## 3 29.93570 18.371426
## 4 30.48810 19.527330
## 5 34.26935 20.048303
## 6 23.18296 15.562555
##
## [[2]]
## days_prior_c MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 1 to 7 0.2538294 0.1462345 0.1261150 0.1750052
## 2 15 to 21 0.5779082 0.4482276 0.2578506 0.4071492
## 3 22 to 28 0.6032598 0.5421447 0.2688598 0.4367779
## 4 29 to 60 0.6077286 0.7128861 0.2743003 0.4606706
## 5 60 or more 0.5934720 0.7844658 0.2240510 0.5445456
## 6 8 to 14 0.5093517 0.3311312 0.2295127 0.3283251
## MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1 0.1731570 0.1229065
## 2 0.4212440 0.2571184
## 3 0.4610295 0.2713249
## 4 0.4658615 0.2822222
## 5 0.5558918 0.2526111
## 6 0.3311637 0.2268515
# by day of week
cross_result_error("MLKEP","DOW")
## [[1]]
## DOW MAE_add MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a MAE_fc_add_fc_hw_m
## 1 Sun 40.94712 32.44107 10.32042 18.05952 18.04410
## 2 Mon 35.54116 74.01959 20.94503 25.56145 25.59021
## 3 Tue 51.18409 77.93646 20.49541 25.69584 25.76140
## 4 Wed 47.87701 92.37488 20.59539 25.17492 25.27315
## 5 Thu 26.50744 58.35156 19.93605 25.66179 25.66932
## 6 Fri 35.77928 62.98778 14.43518 21.66939 21.67287
## 7 Sat 28.38036 97.25092 21.83446 26.92492 26.90461
## MAE_fc_add_mDOW_fc_hw_a
## 1 10.76672
## 2 20.96791
## 3 19.90494
## 4 19.95781
## 5 19.63722
## 6 13.75150
## 7 20.67573
##
## [[2]]
## DOW MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 Sun 1.3337987 0.5686062 0.2380349 0.5068201
## 2 Mon 0.3567670 0.5837443 0.2435203 0.3356350
## 3 Tue 0.4262173 0.5580133 0.2436829 0.3583691
## 4 Wed 0.3427439 0.6571530 0.1812571 0.2471375
## 5 Thu 0.5149395 0.5892349 0.3413117 0.5185825
## 6 Fri 0.7651258 0.7159496 0.1915158 0.3862642
## 7 Sat 0.3539726 0.7632572 0.2289642 0.3306549
## MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1 0.5055928 0.2568672
## 2 0.3356333 0.2556876
## 3 0.3581649 0.2531758
## 4 0.2485948 0.1854063
## 5 0.5185126 0.3524013
## 6 0.3859837 0.2164356
## 7 0.3302099 0.2351247
# by days prior category
head(out_compare_dataset("MLKEP","days_prior_c"))
## hotel days_prior_c stay_date CONF_DT forecast_period month DOW
## 1 MLKEP 1 to 7 2009-11-01 2009-10-31 1m_Nov_out 11 Sun
## 2 MLKEP 1 to 7 2009-11-01 2009-10-31 3m_Nov-Jan_out 11 Sun
## 3 MLKEP 1 to 7 2009-11-01 2009-10-31 6m_Nov-Apr_out 11 Sun
## 4 MLKEP 1 to 7 2009-11-02 2009-10-31 1m_Nov_out 11 Mon
## 5 MLKEP 1 to 7 2009-11-02 2009-10-31 3m_Nov-Jan_out 11 Mon
## 6 MLKEP 1 to 7 2009-11-02 2009-10-31 6m_Nov-Apr_out 11 Mon
## days_prior final_arrivals fc_naive fc_add_mDOW fc_add fc_mul
## 1 1 31 47 35.8 40.76685 34.12768
## 2 1 31 47 35.8 40.76685 34.12768
## 3 1 31 47 35.8 40.76685 34.12768
## 4 2 90 159 99.5 91.38434 90.93525
## 5 2 90 159 99.5 91.38434 90.93525
## 6 2 90 159 99.5 91.38434 90.93525
## fc_hw_a fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1 9.680091 27.15421 18.39077 32.57252
## 2 9.680091 27.15421 18.39077 32.57252
## 3 9.680091 27.15421 18.39077 32.57252
## 4 76.327811 61.08958 87.42660 99.40906
## 5 76.327811 61.08958 87.42660 99.40906
## 6 76.327811 61.08958 87.42660 99.40906
## fc_add_mDOW.fc_hw_m
## 1 33.71037
## 2 33.71037
## 3 33.71037
## 4 99.31636
## 5 99.31636
## 6 99.31636
# by DOW
head(out_compare_dataset("MLKEP","DOW"))
## hotel DOW stay_date CONF_DT forecast_period days_prior_c month
## 1 MLKEP Fri 2010-03-12 2009-10-31 6m_Nov-Apr_out 60 or more 3
## 2 MLKEP Fri 2009-11-20 2009-10-31 3m_Nov-Jan_out 15 to 21 11
## 3 MLKEP Fri 2010-03-05 2009-12-31 3m_Jan-Mar_out 60 or more 3
## 4 MLKEP Fri 2009-11-06 2009-10-31 6m_Nov-Apr_out 1 to 7 11
## 5 MLKEP Fri 2010-01-15 2009-12-31 1m_Jan_out 15 to 21 1
## 6 MLKEP Fri 2009-11-20 2009-10-31 1m_Nov_out 15 to 21 11
## days_prior final_arrivals fc_naive fc_add_mDOW fc_add fc_mul
## 1 132 28 54 50.00000 99.81579 30.11797
## 2 20 61 36 45.50000 82.97258 42.14541
## 3 64 42 50 58.33333 95.28125 35.37522
## 4 6 39 38 39.50000 57.90893 29.19774
## 5 15 32 41 29.00000 75.21168 25.16342
## 6 20 61 36 45.50000 82.97258 42.14541
## fc_hw_a fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1 24.11947 32.63922 74.32751 50.58052
## 2 24.30545 33.85222 50.40206 44.20644
## 3 -16.47771 20.74020 70.04504 61.55458
## 4 24.37548 34.29604 14.81060 35.70400
## 5 -16.14890 20.90702 41.53091 19.98682
## 6 24.30545 33.85222 50.40206 44.20644
## fc_add_mDOW.fc_hw_m
## 1 50.23946
## 2 43.91459
## 3 61.51113
## 4 35.42782
## 5 19.92871
## 6 43.91459
# by days prior category
out_crosss_result_error("MLKEP","days_prior_c")
## [[1]]
## # A tibble: 11 x 8
## # Groups: forecast_period [11]
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 19.9 42.9 51.2 25.0 35.7
## 2 3m_Nov-Jan_out 19.6 44.3 52.7 25.3 37.6
## 3 3m_Dec-Feb_out 19.2 40.5 48.8 26.3 35.0
## 4 3m_Jan-Mar_out 16.2 39.6 58.5 18.1 43.3
## 5 3m_Feb-Apr_out 16.2 37.9 62.5 14.9 25.6
## 6 1m_Nov_out 20.7 37.0 38.4 14.0 34.9
## 7 1m_Dec_out 20.2 35.6 26.5 29.2 34.9
## 8 1m_Jan_out 16.7 39.1 40.9 20.3 42.3
## 9 1m_Feb_out 13.8 31.3 33.6 9.83 18.0
## 10 1m_Mar_out 17.1 31.4 35.3 13.5 19.1
## 11 1m_Apr_out 24 34.3 34.3 12.9 22.4
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[2]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 0.741 0.652 0.439 0.556
## 2 3m_Nov-Jan_out 0.761 0.680 0.458 0.582
## 3 3m_Dec-Feb_out 0.783 0.571 0.503 0.814
## 4 3m_Jan-Mar_out 0.597 0.510 0.229 0.443
## 5 3m_Feb-Apr_out 0.533 0.610 0.194 0.343
## 6 1m_Nov_out 0.371 0.334 0.126 0.291
## 7 1m_Dec_out 0.765 0.442 0.679 0.888
## 8 1m_Jan_out 0.746 0.365 0.295 0.510
## 9 1m_Feb_out 0.406 0.344 0.114 0.198
## 10 1m_Mar_out 0.388 0.358 0.159 0.215
## 11 1m_Apr_out 0.433 0.368 0.156 0.222
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAPE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[3]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 2.16 2.58 1.26 1.80
## 2 3m_Nov-Jan_out 2.25 2.68 1.29 1.91
## 3 3m_Dec-Feb_out 2.11 2.54 1.37 1.82
## 4 3m_Jan-Mar_out 2.44 3.61 1.12 2.67
## 5 3m_Feb-Apr_out 2.34 3.86 0.922 1.58
## 6 1m_Nov_out 1.79 1.86 0.678 1.69
## 7 1m_Dec_out 1.76 1.31 1.45 1.73
## 8 1m_Jan_out 2.35 2.45 1.22 2.54
## 9 1m_Feb_out 2.27 2.44 0.715 1.31
## 10 1m_Mar_out 1.83 2.06 0.786 1.11
## 11 1m_Apr_out 1.43 1.43 0.537 0.935
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## # MASE_fc_add_mDOW.fc_hw_m <dbl>
# by DOW
out_crosss_result_error("MLKEP","DOW")
## [[1]]
## # A tibble: 11 x 8
## # Groups: forecast_period [11]
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 19.9 42.9 51.2 25.0 30.1
## 2 3m_Nov-Jan_out 19.6 44.3 52.7 25.3 31.1
## 3 3m_Dec-Feb_out 19.2 40.5 48.8 26.3 27.5
## 4 3m_Jan-Mar_out 16.2 39.6 58.5 18.1 21.2
## 5 3m_Feb-Apr_out 16.2 37.9 62.5 14.9 19.0
## 6 1m_Nov_out 20.7 37.0 38.4 14.0 25.0
## 7 1m_Dec_out 20.2 35.6 26.5 29.2 33.0
## 8 1m_Jan_out 16.7 39.1 40.9 20.3 25.3
## 9 1m_Feb_out 13.8 31.3 33.6 9.83 14.5
## 10 1m_Mar_out 17.1 31.4 35.3 13.5 15.4
## 11 1m_Apr_out 24 34.3 34.3 12.9 16.1
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[2]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 0.741 0.652 0.439 0.581
## 2 3m_Nov-Jan_out 0.761 0.680 0.458 0.615
## 3 3m_Dec-Feb_out 0.783 0.571 0.503 0.600
## 4 3m_Jan-Mar_out 0.597 0.510 0.229 0.290
## 5 3m_Feb-Apr_out 0.533 0.610 0.194 0.260
## 6 1m_Nov_out 0.371 0.334 0.126 0.263
## 7 1m_Dec_out 0.765 0.442 0.679 0.835
## 8 1m_Jan_out 0.746 0.365 0.295 0.401
## 9 1m_Feb_out 0.406 0.344 0.114 0.182
## 10 1m_Mar_out 0.388 0.358 0.159 0.157
## 11 1m_Apr_out 0.433 0.368 0.156 0.199
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAPE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[3]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 2.16 2.58 1.26 1.51
## 2 3m_Nov-Jan_out 2.25 2.68 1.29 1.58
## 3 3m_Dec-Feb_out 2.11 2.54 1.37 1.43
## 4 3m_Jan-Mar_out 2.44 3.61 1.12 1.31
## 5 3m_Feb-Apr_out 2.34 3.86 0.922 1.17
## 6 1m_Nov_out 1.79 1.86 0.678 1.21
## 7 1m_Dec_out 1.76 1.31 1.45 1.63
## 8 1m_Jan_out 2.35 2.45 1.22 1.52
## 9 1m_Feb_out 2.27 2.44 0.715 1.06
## 10 1m_Mar_out 1.83 2.06 0.786 0.897
## 11 1m_Apr_out 1.43 1.43 0.537 0.671
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## # MASE_fc_add_mDOW.fc_hw_m <dbl>
Observations
# by days prior category
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add","fc_hw_a","days_prior_c")
weight1 <- list.remove(fc1,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -22.8319 0.9506 0.3311
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -34.6808 0.8502 0.5782
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -34.3787 0.7792 0.6454
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -37.8344 0.8215 0.6422
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -52.0378 1.0076 0.6167
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -107.5397 1.7011 0.5165
#fc1$dataset
## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_a","days_prior_c")
weight2 <- list.remove(fc2,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 0.04751 0.94525 0.05878
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 0.96580 0.96209 0.03626
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 0.75930 0.98336 0.01964
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 0.29110 0.97964 0.02822
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -1.05465 0.95042 0.06938
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -2.53707 0.97653 0.04308
#fc3$dataset
## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_m","days_prior_c")
weight3 <- list.remove(fc3,c("dataset")) %>% print()
## $`1 to 7`
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 0.21389 0.95382 0.04824
##
##
## $`8 to 14`
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 0.39948 0.95698 0.04827
##
##
## $`15 to 21`
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 1.281093 1.000511 -0.003414
##
##
## $`22 to 28`
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 0.967731 1.002085 -0.001906
##
##
## $`29 to 60`
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -0.14226 0.98904 0.02124
##
##
## $`60 or more`
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -1.57458 0.99777 0.01093
#fc4$dataset
# by DOW
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add","fc_hw_a","DOW")
weight1 <- list.remove(fc1,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -0.4003 0.4076 0.1012
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 13.62147 0.84378 0.02152
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 42.97060 0.70586 0.06587
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## 43.2786 0.5672 0.1176
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -5.45833 0.92625 0.06893
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -63.590 1.627 -0.104
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add fc_hw_a
## -1.988 1.240 -0.155
#fc1$dataset
## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_a","DOW")
weight2 <- list.remove(fc2,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -1.54439 0.98181 0.04492
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -8.25075 1.03222 0.05683
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -4.99754 0.97041 0.07663
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -9.9731 0.9733 0.1113
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## -2.5312 0.9194 0.1108
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 0.48448 0.99337 -0.01639
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_a
## 6.49266 0.96818 -0.02488
#fc2$dataset
## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_m","DOW")
weight3 <- list.remove(fc3,c("dataset")) %>% print()
## $Sun
##
## Call:
## lm(formula = formula, data = hotel_dataset1)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -1.30391 0.99359 0.02321
##
##
## $Mon
##
## Call:
## lm(formula = formula, data = hotel_dataset2)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -2.916057 1.030373 -0.005092
##
##
## $Tue
##
## Call:
## lm(formula = formula, data = hotel_dataset3)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 3.2000731 0.9733635 0.0005902
##
##
## $Wed
##
## Call:
## lm(formula = formula, data = hotel_dataset4)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -0.47276 0.98094 0.01915
##
##
## $Thu
##
## Call:
## lm(formula = formula, data = hotel_dataset5)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 4.03645 0.92153 0.02564
##
##
## $Fri
##
## Call:
## lm(formula = formula, data = hotel_dataset6)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## -1.144454 0.993038 0.009081
##
##
## $Sat
##
## Call:
## lm(formula = formula, data = hotel_dataset7)
##
## Coefficients:
## (Intercept) fc_add_mDOW fc_hw_m
## 3.522440 0.967765 0.006172
#fc3$dataset
` ### compare result errors from advance and combined models using training data
# by days prior category
cross_result_error("WARUK","days_prior_c")
## [[1]]
## days_prior_c MAE_add MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a
## 1 1 to 7 13.16747 13.78440 8.470605 10.91619
## 2 15 to 21 26.17872 37.37894 13.496697 19.67645
## 3 22 to 28 27.50415 42.70794 14.236632 20.89803
## 4 29 to 60 28.22480 50.34067 14.949365 21.52320
## 5 60 or more 28.35742 44.87594 13.120235 23.28486
## 6 8 to 14 23.19617 29.14020 12.445378 17.66167
## MAE_fc_add_fc_hw_m MAE_fc_add_mDOW_fc_hw_a
## 1 11.19652 8.429701
## 2 21.07948 13.483197
## 3 22.67395 14.222271
## 4 24.64998 14.849603
## 5 26.22888 13.129507
## 6 18.41534 12.439229
##
## [[2]]
## days_prior_c MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 1 to 7 0.2587100 0.1678449 0.1333314 0.1890131
## 2 15 to 21 0.5089602 0.4503076 0.2100129 0.3382934
## 3 22 to 28 0.5368596 0.5170701 0.2208814 0.3650624
## 4 29 to 60 0.5508472 0.5995817 0.2306938 0.3768414
## 5 60 or more 0.5348635 0.5317925 0.1950102 0.3862016
## 6 8 to 14 0.4625152 0.3514595 0.2042149 0.3160088
## MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1 0.1939150 0.1380430
## 2 0.3787438 0.2140657
## 3 0.4188758 0.2245825
## 4 0.4605326 0.2323704
## 5 0.4648628 0.1922066
## 6 0.3327093 0.2099423
# by day of week
cross_result_error("WARUK","DOW")
## [[1]]
## DOW MAE_add MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a MAE_fc_add_fc_hw_m
## 1 Sun 45.06411 17.35045 8.395196 11.49850 11.37448
## 2 Mon 20.25517 34.96238 16.023921 20.29259 20.28799
## 3 Tue 29.53430 54.29384 14.300678 18.28677 18.32942
## 4 Wed 23.92818 52.25561 13.931884 17.25048 17.33644
## 5 Thu 19.28235 31.42635 13.950200 18.28369 18.34782
## 6 Fri 26.76339 43.46796 12.618289 19.61610 19.60954
## 7 Sat 25.31154 67.69345 13.433780 24.85638 24.83832
## MAE_fc_add_mDOW_fc_hw_a
## 1 8.40671
## 2 15.97440
## 3 14.22321
## 4 13.79342
## 5 13.83609
## 6 12.59668
## 7 13.45303
##
## [[2]]
## DOW MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 Sun 1.6701665 0.4929499 0.2700668 0.3904811
## 2 Mon 0.2789003 0.4032735 0.2310543 0.2900457
## 3 Tue 0.2961594 0.5158522 0.1775399 0.2453709
## 4 Wed 0.2363424 0.5204803 0.1563924 0.2072590
## 5 Thu 0.3154169 0.4342376 0.2137521 0.2799274
## 6 Fri 0.5499524 0.5872966 0.1947371 0.3439894
## 7 Sat 0.3383350 0.6546574 0.1688589 0.3471894
## MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1 0.3893193 0.2665331
## 2 0.2898848 0.2272126
## 3 0.2453085 0.1786934
## 4 0.2082605 0.1543252
## 5 0.2808418 0.2132284
## 6 0.3433573 0.1921644
## 7 0.3459637 0.1746703
# by days prior category
head(out_compare_dataset("WARUK","days_prior_c"))
## hotel days_prior_c stay_date CONF_DT forecast_period month DOW
## 1 WARUK 1 to 7 2009-11-01 2009-10-31 1m_Nov_out 11 Sun
## 2 WARUK 1 to 7 2009-11-01 2009-10-31 3m_Nov-Jan_out 11 Sun
## 3 WARUK 1 to 7 2009-11-01 2009-10-31 6m_Nov-Apr_out 11 Sun
## 4 WARUK 1 to 7 2009-11-02 2009-10-31 1m_Nov_out 11 Mon
## 5 WARUK 1 to 7 2009-11-02 2009-10-31 3m_Nov-Jan_out 11 Mon
## 6 WARUK 1 to 7 2009-11-02 2009-10-31 6m_Nov-Apr_out 11 Mon
## days_prior final_arrivals fc_naive fc_add_mDOW fc_add fc_mul
## 1 1 29 41 20.8 28.70674 20.09441
## 2 1 29 41 20.8 28.70674 20.09441
## 3 1 29 41 20.8 28.70674 20.09441
## 4 2 67 137 65.0 49.68488 39.81006
## 5 2 67 137 65.0 49.68488 39.81006
## 6 2 67 137 65.0 49.68488 39.81006
## fc_hw_a fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a fc_add_mDOW.fc_hw_m
## 1 24.12845 33.44387 12.44587 21.12701 21.66665
## 2 24.12845 33.44387 12.44587 21.12701 21.66665
## 3 24.12845 33.44387 12.44587 21.12701 21.66665
## 4 60.87769 68.32838 44.55549 65.06727 65.50839
## 5 60.87769 68.32838 44.55549 65.06727 65.50839
## 6 60.87769 68.32838 44.55549 65.06727 65.50839
# by DOW
head(out_compare_dataset("WARUK","DOW"))
## hotel DOW stay_date CONF_DT forecast_period days_prior_c month
## 1 WARUK Fri 2010-01-29 2009-10-31 6m_Nov-Apr_out 60 or more 1
## 2 WARUK Fri 2009-12-11 2009-11-30 3m_Dec-Feb_out 8 to 14 12
## 3 WARUK Fri 2010-02-12 2010-01-31 3m_Feb-Apr_out 8 to 14 2
## 4 WARUK Fri 2010-01-29 2009-10-31 3m_Nov-Jan_out 60 or more 1
## 5 WARUK Fri 2009-12-18 2009-11-30 3m_Dec-Feb_out 15 to 21 12
## 6 WARUK Fri 2010-01-01 2009-12-31 3m_Jan-Mar_out 1 to 7 1
## days_prior final_arrivals fc_naive fc_add_mDOW fc_add fc_mul
## 1 90 26 25 27.00 83.26682 22.32962
## 2 11 64 62 64.25 91.00182 106.81377
## 3 12 29 40 36.25 63.58652 29.10090
## 4 90 26 25 27.00 83.26682 22.32962
## 5 18 51 54 59.25 74.15596 48.89513
## 6 1 20 34 21.40 26.70674 17.73036
## fc_hw_a fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a fc_add_mDOW.fc_hw_m
## 1 57.69939 62.20178 65.87560 26.35978 26.23245
## 2 51.62973 50.53287 79.09134 63.46227 63.11716
## 3 38.02932 33.57421 35.90379 35.87083 35.15808
## 4 57.69939 62.20178 65.87560 26.35978 26.23245
## 5 51.62913 50.56414 51.68451 58.49543 58.15225
## 6 19.89827 34.24062 -22.21035 21.41646 20.41751
# by days prior category
out_crosss_result_error("WARUK","days_prior_c")
## [[1]]
## # A tibble: 11 x 8
## # Groups: forecast_period [11]
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 22.3 32.8 33.3 18.0 24.4
## 2 3m_Nov-Jan_out 24.1 34.5 29.9 18.0 24.6
## 3 3m_Dec-Feb_out 19.8 32.0 32.4 16.6 23.2
## 4 3m_Jan-Mar_out 15.8 26.3 39.0 14.0 22.8
## 5 3m_Feb-Apr_out 17.9 22.3 32.0 16.3 16.6
## 6 1m_Nov_out 26.9 26.9 28.5 15.0 21.0
## 7 1m_Dec_out 26.3 28.4 23.4 18.9 22.8
## 8 1m_Jan_out 17.3 27.8 28.9 9.07 18.0
## 9 1m_Feb_out 13.2 20.8 22.8 14.0 15.5
## 10 1m_Mar_out 17.9 19.9 25.5 12.5 12.9
## 11 1m_Apr_out 31.5 22.3 27.6 17.3 13.4
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[2]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.05 0.537 0.461 0.669
## 2 3m_Nov-Jan_out 1.20 0.548 0.515 0.757
## 3 3m_Dec-Feb_out 1.14 0.606 0.505 0.787
## 4 3m_Jan-Mar_out 0.738 0.565 0.266 0.333
## 5 3m_Feb-Apr_out 0.500 0.432 0.250 0.268
## 6 1m_Nov_out 0.668 0.437 0.304 0.413
## 7 1m_Dec_out 1.14 0.586 0.713 0.916
## 8 1m_Jan_out 0.959 0.515 0.257 0.340
## 9 1m_Feb_out 0.494 0.326 0.237 0.268
## 10 1m_Mar_out 0.431 0.346 0.190 0.219
## 11 1m_Apr_out 0.720 0.408 0.446 0.410
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAPE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[3]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.47 1.49 0.806 1.09
## 2 3m_Nov-Jan_out 1.43 1.24 0.749 1.02
## 3 3m_Dec-Feb_out 1.61 1.63 0.836 1.17
## 4 3m_Jan-Mar_out 1.67 2.48 0.890 1.45
## 5 3m_Feb-Apr_out 1.25 1.79 0.909 0.926
## 6 1m_Nov_out 1.00 1.06 0.558 0.782
## 7 1m_Dec_out 1.08 0.889 0.719 0.866
## 8 1m_Jan_out 1.60 1.67 0.524 1.04
## 9 1m_Feb_out 1.58 1.73 1.06 1.18
## 10 1m_Mar_out 1.11 1.42 0.699 0.717
## 11 1m_Apr_out 0.708 0.875 0.549 0.426
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## # MASE_fc_add_mDOW.fc_hw_m <dbl>
# by DOW
out_crosss_result_error("WARUK","DOW")
## [[1]]
## # A tibble: 11 x 8
## # Groups: forecast_period [11]
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 22.3 32.8 33.3 18.0 21.2
## 2 3m_Nov-Jan_out 24.1 34.5 29.9 18.0 21.8
## 3 3m_Dec-Feb_out 19.8 32.0 32.4 16.6 23.0
## 4 3m_Jan-Mar_out 15.8 26.3 39.0 14.0 16.4
## 5 3m_Feb-Apr_out 17.9 22.3 32.0 16.3 14.5
## 6 1m_Nov_out 26.9 26.9 28.5 15.0 11.9
## 7 1m_Dec_out 26.3 28.4 23.4 18.9 24.7
## 8 1m_Jan_out 17.3 27.8 28.9 9.07 15.1
## 9 1m_Feb_out 13.2 20.8 22.8 14.0 13.6
## 10 1m_Mar_out 17.9 19.9 25.5 12.5 13.6
## 11 1m_Apr_out 31.5 22.3 27.6 17.3 14.5
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[2]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.05 0.537 0.461 0.636
## 2 3m_Nov-Jan_out 1.20 0.548 0.515 0.721
## 3 3m_Dec-Feb_out 1.14 0.606 0.505 0.769
## 4 3m_Jan-Mar_out 0.738 0.565 0.266 0.380
## 5 3m_Feb-Apr_out 0.500 0.432 0.250 0.241
## 6 1m_Nov_out 0.668 0.437 0.304 0.264
## 7 1m_Dec_out 1.14 0.586 0.713 0.980
## 8 1m_Jan_out 0.959 0.515 0.257 0.476
## 9 1m_Feb_out 0.494 0.326 0.237 0.233
## 10 1m_Mar_out 0.431 0.346 0.190 0.217
## 11 1m_Apr_out 0.720 0.408 0.446 0.462
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## # MAPE_fc_add_mDOW.fc_hw_m <dbl>
##
## [[3]]
## # A tibble: 11 x 7
## # Groups: forecast_period [11]
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.47 1.49 0.806 0.950
## 2 3m_Nov-Jan_out 1.43 1.24 0.749 0.905
## 3 3m_Dec-Feb_out 1.61 1.63 0.836 1.16
## 4 3m_Jan-Mar_out 1.67 2.48 0.890 1.04
## 5 3m_Feb-Apr_out 1.25 1.79 0.909 0.812
## 6 1m_Nov_out 1.00 1.06 0.558 0.444
## 7 1m_Dec_out 1.08 0.889 0.719 0.938
## 8 1m_Jan_out 1.60 1.67 0.524 0.870
## 9 1m_Feb_out 1.58 1.73 1.06 1.03
## 10 1m_Mar_out 1.11 1.42 0.699 0.757
## 11 1m_Apr_out 0.708 0.875 0.549 0.461
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## # MASE_fc_add_mDOW.fc_hw_m <dbl>
Observations
nn_dataset <- filled_data_full %>%
mutate(month = as.factor(month(month)),quarter= as.factor(quarter(quarter))) %>%
filter(days_prior!=0) # filter out final_day forecast
lag_booking <- function(hotelname,lagday) {
d_m <-nn_dataset %>% filter(hotel == hotelname) %>% select(c(stay_date,final_arrivals)) %>% distinct() %>% rename(lagdate = stay_date, date_book = final_arrivals)
lag_booking<- nn_dataset %>% filter(hotel == hotelname) %>% mutate(lagdate = stay_date - lagday) %>% left_join(d_m,by = "lagdate") %>% select(date_book) %>% rename(!!paste0("lag",lagday) := date_book)
return(lag_booking)
}
set.seed(12345)
#training_data <- filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
#test_data <- filled_data_full %>% filter(stay_date >= '2009-11-1')
# Choose lagday for the hotel
lagday <- c(1,2,3,4,5,6,7,14,21,364)
Mod_data_G <- cbind(nn_dataset[nn_dataset[, "hotel"] =="GLWST",],data.frame(lapply(lagday,lag_booking,hotelname="GLWST"))) %>% select(c("stay_date","CONF_DT","cum_bookings","final_arrivals","days_prior","lag1","lag2","lag3","lag4","lag5","lag6","lag7","lag14","lag21","lag364"))
Mod_data_G <- Mod_data_G %>% mutate(fc_naive=Mod_data_G$lag364 )
# check NA in columns
apply(Mod_data_G,2,function(x) sum(is.na(x)))
## stay_date CONF_DT cum_bookings final_arrivals days_prior
## 0 0 0 0 0
## lag1 lag2 lag3 lag4 lag5
## 175 292 603 915 1228
## lag6 lag7 lag14 lag21 lag364
## 1342 1617 3151 4564 69027
## fc_naive
## 69027
# omit NA in columns
Mod_data_G <- na.omit(Mod_data_G)
#scaled variables except dummy and denpendent variables
scaled_variables <- preProcess(Mod_data_G[,-c(4,ncol(Mod_data_G))])
NN_scaled_G <- Mod_data_G_scaled <- predict(scaled_variables,Mod_data_G)
# transfer dummy variables
#NN_scaled_G <- fastDummies::dummy_cols(Mod_data_G_scaled,remove_first_dummy = TRUE,select_columns = c("DOW","month","quarter"))
# Training dataset
NN_train_G <- NN_scaled_G %>% filter(stay_date < '2009-11-1')
# check variables in the dataset
glimpse(NN_train_G)
## Observations: 36,595
## Variables: 16
## $ stay_date <date> 2009-04-30, 2009-04-30, 2009-04-30, 2009-04-30, …
## $ CONF_DT <date> 2008-11-13, 2008-11-14, 2008-11-15, 2008-11-16, …
## $ cum_bookings <dbl> -0.6520675, -0.6520675, -0.6520675, -0.6520675, -…
## $ final_arrivals <dbl> 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,…
## $ days_prior <dbl> 0.8805090, 0.8665870, 0.8526650, 0.8387430, 0.824…
## $ lag1 <dbl> 0.9190474, 0.9190474, 0.9190474, 0.9190474, 0.919…
## $ lag2 <dbl> 0.9788104, 0.9788104, 0.9788104, 0.9788104, 0.978…
## $ lag3 <dbl> -0.6814955, -0.6814955, -0.6814955, -0.6814955, -…
## $ lag4 <dbl> -1.375279, -1.375279, -1.375279, -1.375279, -1.37…
## $ lag5 <dbl> 0.9841595, 0.9841595, 0.9841595, 0.9841595, 0.984…
## $ lag6 <dbl> 0.893311, 0.893311, 0.893311, 0.893311, 0.893311,…
## $ lag7 <dbl> 0.1404054, 0.1404054, 0.1404054, 0.1404054, 0.140…
## $ lag14 <dbl> -0.3916876, -0.3916876, -0.3916876, -0.3916876, -…
## $ lag21 <dbl> 0.7083039, 0.7083039, 0.7083039, 0.7083039, 0.708…
## $ lag364 <dbl> 0.4138432, 0.4138432, 0.4138432, 0.4138432, 0.413…
## $ fc_naive <dbl> 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,…
# Fit the modle
n <- names(NN_train_G)
f <- as.formula(paste("final_arrivals ~", paste(n[!n %in% c("final_arrivals","stay_date","CONF_DT","fc_naive")], collapse = " + ")))
# method 1
nn_fit_G1 <- neuralnet(f,NN_train_G,hidden=c(0),linear.output=T,threshold=100,lifesign="full",lifesign.step=50)
## hidden: 0 thresh: 100 rep: 1/1 steps: 50 min thresh: 3287940.71386564
## 100 min thresh: 2461442.55122172
## 150 min thresh: 1905129.58186451
## 200 min thresh: 1750757.08467301
## 250 min thresh: 1632304.3830209
## 300 min thresh: 1529972.48830384
## 350 min thresh: 1426450.88004197
## 400 min thresh: 1322359.94131812
## 450 min thresh: 1218528.07761978
## 500 min thresh: 1116256.47308815
## 550 min thresh: 1009693.82383128
## 600 min thresh: 908267.489472109
## 650 min thresh: 802796.580165802
## 700 min thresh: 700539.31681408
## 750 min thresh: 598141.438603911
## 800 min thresh: 494807.206554517
## 850 min thresh: 390413.01358989
## 900 min thresh: 286895.273556604
## 950 min thresh: 181934.107176451
## 1000 min thresh: 80253.9001254068
## 1050 min thresh: 605.657855171973
## 1082 error: 4334897.98201 time: 2.67 secs
#plot(nn_fit_G1)
result_train_G <- data.frame(NN_train_G$stay_date, NN_train_G$CONF_DT, nn_fit_G1$net.result,"GLWST")
names(result_train_G)= c("stay_date", "CONF_DT","fc_nn","hotel")
# Test dataset
NN_test_G <- NN_scaled_G %>% filter(stay_date >= '2009-11-1')
# check variables in the dataset
#glimpse(NN_testdataset_G )
# check NA in columns
#apply(NN_test_G,2,function(x) sum(is.na(x)))
# forecast the training model
NN_pred_test_G1 <- neuralnet::compute(nn_fit_G1,NN_test_G[-c(4)])
result_test_G<- data.frame(stay_date = NN_test_G$stay_date, CONF_DT = NN_test_G$CONF_DT,actual= NN_test_G$final_arrivals, fc_nn = NN_pred_test_G1$net.result,fc_naive =NN_test_G$fc_naive)
# merge dataset as the daysprior format
result_test_NN_G <- fc_hw_daysprior(1,"additive") %>% select(c("stay_date","CONF_DT","forecast_period") )%>% left_join(result_test_G, by = c("stay_date","CONF_DT")) %>% na.omit() %>% cbind(hotel="GLWST")
# calculate NN models errors
nn_result_out_G <- result_test_NN_G %>%
group_by(forecast_period) %>%
# MAE error measurements
summarise( MAE_nn = sum(abs(actual-fc_nn))/n(),
MAE_naive = sum(abs(actual-fc_naive))/n(),
# MAPE error measurements
MAPE_nn = sum(abs(actual-fc_nn)/actual)/n(),
# MASE error measurements compared to naive model
MASE_nn = MAE_nn/MAE_naive)
nn_result_out_G<-txtRound(nn_result_out_G[,-1],2)
nn_result_out_G <- data.frame(forecast_period=fc_timestamp_out,nn_result_out_G)
htmlTable(nn_result_out_G)
| forecast_period | MAE_nn | MAE_naive | MAPE_nn | MASE_nn | |
|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 14.78 | 17.96 | 0.21 | 0.82 |
| 2 | 3m_Nov-Jan_out | 15.01 | 18.64 | 0.25 | 0.81 |
| 3 | 3m_Dec-Feb_out | 15.24 | 16.90 | 0.25 | 0.90 |
| 4 | 3m_Jan-Mar_out | 15.76 | 16.65 | 0.21 | 0.95 |
| 5 | 3m_Feb-Apr_out | 14.87 | 21.05 | 0.18 | 0.71 |
| 6 | 1m_Nov_out | 11.68 | 17.33 | 0.13 | 0.67 |
| 7 | 1m_Dec_out | 17.09 | 21.42 | 0.34 | 0.80 |
| 8 | 1m_Jan_out | 14.65 | 15.74 | 0.25 | 0.93 |
| 9 | 1m_Feb_out | 10.56 | 13.25 | 0.13 | 0.80 |
| 10 | 1m_Mar_out | 18.15 | 26.94 | 0.23 | 0.67 |
| 11 | 1m_Apr_out | 12.97 | 22.20 | 0.16 | 0.58 |
set.seed(12345)
#training_data <- filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
#test_data <- filled_data_full %>% filter(stay_date >= '2009-11-1')
# Choose lagday for the hotel
lagday <- c(1,2,3,4,5,6,7,14,21,364)
Mod_data_M <- cbind(nn_dataset[nn_dataset[, "hotel"] =="MLKEP",],data.frame(lapply(lagday,lag_booking,hotelname="MLKEP"))) %>% select(c("stay_date","CONF_DT","cum_bookings","final_arrivals","days_prior","lag1","lag2","lag3","lag4","lag5","lag6","lag7","lag14","lag21","lag364"))
Mod_data_M <- Mod_data_M %>% mutate(fc_naive=Mod_data_M$lag364 )
# check NA in columns
apply(Mod_data_M,2,function(x) sum(is.na(x)))
## stay_date CONF_DT cum_bookings final_arrivals days_prior
## 0 0 0 0 0
## lag1 lag2 lag3 lag4 lag5
## 90 197 320 429 558
## lag6 lag7 lag14 lag21 lag364
## 688 753 1243 1629 33913
## fc_naive
## 33913
# omit NA in columns
Mod_data_M <- na.omit(Mod_data_M)
#scaled variables except dummy and denpendent variables
scaled_variables <- preProcess(Mod_data_M[,-c(4,ncol(Mod_data_M))])
NN_scaled_M <- Mod_data_M_scaled <- predict(scaled_variables,Mod_data_M)
# transfer dummy variables
#NN_scaled_G <- fastDummies::dummy_cols(Mod_data_G_scaled,remove_first_dummy = TRUE,select_columns = c("DOW","month","quarter"))
# Training dataset
NN_train_M <- NN_scaled_M %>% filter(stay_date < '2009-11-1')
# check variables in the dataset
#glimpse(NN_train_M)
# Fit the modle
n <- names(NN_train_M)
f <- as.formula(paste("final_arrivals ~", paste(n[!n %in% c("final_arrivals","stay_date","CONF_DT","fc_naive")], collapse = " + ")))
# method 1
nn_fit_M1 <- neuralnet(f,NN_train_M,hidden=c(0),linear.output=T,threshold=100,lifesign="full",lifesign.step=50)
## hidden: 0 thresh: 100 rep: 1/1 steps: 50 min thresh: 2690765.35205737
## 100 min thresh: 2472193.47866376
## 150 min thresh: 2275886.68673817
## 200 min thresh: 2109977.64399122
## 250 min thresh: 1971424.57576136
## 300 min thresh: 1847326.59100435
## 350 min thresh: 1722876.26618413
## 400 min thresh: 1598414.58062551
## 450 min thresh: 1473861.2270335
## 500 min thresh: 1349438.11026541
## 550 min thresh: 1225383.24490788
## 600 min thresh: 1100634.30196423
## 650 min thresh: 976075.3076495
## 700 min thresh: 851829.808584916
## 750 min thresh: 727225.264395953
## 800 min thresh: 602662.677088679
## 850 min thresh: 478533.297001231
## 900 min thresh: 353881.848832607
## 950 min thresh: 229793.235046016
## 1000 min thresh: 105149.241001303
## 1050 min thresh: 351.685367844636
## 1055 error: 9861383.10098 time: 2.09 secs
#plot(nn_fit_M1)
result_train_M <- data.frame(NN_train_M$stay_date, NN_train_M$CONF_DT, nn_fit_M1$net.result,"MLKEP")
names(result_train_M)= c("stay_date", "CONF_DT","fc_nn","hotel")
# Test dataset
NN_test_M <- NN_scaled_M %>% filter(stay_date >= '2009-11-1')
# check variables in the dataset
#glimpse(NN_testdataset_M )
# check NA in columns
#apply(NN_test_M,2,function(x) sum(is.na(x)))
# forecast the training model
NN_pred_test_M1 <- neuralnet::compute(nn_fit_M1,NN_test_M[-c(4)])
result_test_M1<- data.frame(stay_date = NN_test_M$stay_date, CONF_DT = NN_test_M$CONF_DT,actual= NN_test_M$final_arrivals, fc_nn = NN_pred_test_M1$net.result,fc_naive =NN_test_M$fc_naive)
# merge dataset as the daysprior format
result_test_NN_M <- fc_hw_daysprior(2,"additive") %>% select(c("stay_date","CONF_DT","forecast_period") )%>% left_join(result_test_M1, by = c("stay_date","CONF_DT")) %>% na.omit() %>% cbind(hotel="MLKEP")
# calculate NN models errors
nn_result_out_M <-result_test_NN_M %>%
group_by(forecast_period) %>%
# MAE error measurements
summarise( MAE_nn = sum(abs(actual-fc_nn))/n(),
MAE_naive = sum(abs(actual-fc_naive))/n(),
# MAPE error measurements
MAPE_nn = sum(abs(actual-fc_nn)/actual)/n(),
# MASE error measurements compared to naive model
MASE_nn = MAE_nn/MAE_naive)
nn_result_out_M<-txtRound(nn_result_out_M[,-1],2)
nn_result_out_M <- data.frame(forecast_period=fc_timestamp_out,nn_result_out_M)
htmlTable(nn_result_out_M)
| forecast_period | MAE_nn | MAE_naive | MAPE_nn | MASE_nn | |
|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 20.57 | 19.36 | 0.36 | 1.06 |
| 2 | 3m_Nov-Jan_out | 20.11 | 19.65 | 0.37 | 1.02 |
| 3 | 3m_Dec-Feb_out | 27.39 | 18.43 | 0.41 | 1.49 |
| 4 | 3m_Jan-Mar_out | 20.79 | 15.92 | 0.26 | 1.31 |
| 5 | 3m_Feb-Apr_out | 18.60 | 16.19 | 0.25 | 1.15 |
| 6 | 1m_Nov_out | 17.51 | 20.67 | 0.20 | 0.85 |
| 7 | 1m_Dec_out | 30.09 | 20.23 | 0.61 | 1.49 |
| 8 | 1m_Jan_out | 27.42 | 16.68 | 0.36 | 1.64 |
| 9 | 1m_Feb_out | 18.43 | 13.75 | 0.21 | 1.34 |
| 10 | 1m_Mar_out | 17.99 | 17.13 | 0.23 | 1.05 |
| 11 | 1m_Apr_out | 21.58 | 24.00 | 0.30 | 0.90 |
set.seed(12345)
#training_data <- filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
#test_data <- filled_data_full %>% filter(stay_date >= '2009-11-1')
# Choose lagday for the hotel
lagday <- c(1,2,3,4,5,6,7,14,21,364)
Mod_data_W <- cbind(nn_dataset[nn_dataset[, "hotel"] =="WARUK",],data.frame(lapply(lagday,lag_booking,hotelname="WARUK"))) %>% select(c("stay_date","CONF_DT","cum_bookings","final_arrivals","days_prior","lag1","lag2","lag3","lag4","lag5","lag6","lag7","lag14","lag21","lag364"))
Mod_data_W <- Mod_data_W %>% mutate(fc_naive=Mod_data_W$lag364 )
# check NA in columns
apply(Mod_data_W,2,function(x) sum(is.na(x)))
## stay_date CONF_DT cum_bookings final_arrivals days_prior
## 0 0 0 0 0
## lag1 lag2 lag3 lag4 lag5
## 177 325 474 624 638
## lag6 lag7 lag14 lag21 lag364
## 747 852 2088 3365 52751
## fc_naive
## 52751
# omit NA in columns
Mod_data_W <- na.omit(Mod_data_W)
#scaled variables except dummy and denpendent variables
scaled_variables <- preProcess(Mod_data_W[,-c(4,ncol(Mod_data_W))])
NN_scaled_W <- Mod_data_W_scaled <- predict(scaled_variables,Mod_data_W)
# transfer dummy variables
#NN_scaled_G <- fastDummies::dummy_cols(Mod_data_G_scaled,remove_first_dummy = TRUE,select_columns = c("DOW","month","quarter"))
# Training dataset
NN_train_W <- NN_scaled_W %>% filter(stay_date < '2009-11-1')
# check variables in the dataset
#glimpse(NN_train_W)
# Fit the modle
n <- names(NN_train_W)
f <- as.formula(paste("final_arrivals ~", paste(n[!n %in% c("final_arrivals","stay_date","CONF_DT","fc_naive")], collapse = " + ")))
# method 1
nn_fit_W1 <- neuralnet(f,NN_train_W,hidden=c(0),linear.output=T,threshold=100,lifesign="full",lifesign.step=50)
## hidden: 0 thresh: 100 rep: 1/1 steps: 50 min thresh: 2459756.8423652
## 100 min thresh: 1782671.95176147
## 150 min thresh: 1365755.43802059
## 200 min thresh: 1223615.97345192
## 250 min thresh: 1113100.05744893
## 300 min thresh: 996556.011691862
## 350 min thresh: 884038.04156948
## 400 min thresh: 770162.497638148
## 450 min thresh: 656633.809364625
## 500 min thresh: 543016.800066574
## 550 min thresh: 428717.399948547
## 600 min thresh: 315764.783944399
## 650 min thresh: 203449.532244018
## 700 min thresh: 88259.4762028119
## 750 min thresh: 471.932712521617
## 759 error: 6691634.46756 time: 1.88 secs
#plot(nn_fit_W1)
result_train_W <- data.frame(NN_train_W$stay_date, NN_train_W$CONF_DT, nn_fit_W1$net.result,"WARUK")
names(result_train_W)= c("stay_date", "CONF_DT","fc_nn","hotel")
# Test dataset
NN_test_W <- NN_scaled_W %>% filter(stay_date >= '2009-11-1')
# check variables in the dataset
#glimpse(NN_testdataset_W )
# check NA in columns
#apply(NN_test_W,2,function(x) sum(is.na(x)))
# forecast the training model
NN_pred_test_W1 <- neuralnet::compute(nn_fit_W1,NN_test_W[-c(4)])
result_test_W1<- data.frame(stay_date = NN_test_W$stay_date, CONF_DT = NN_test_W$CONF_DT,actual= NN_test_W$final_arrivals, fc_nn = NN_pred_test_W1$net.result,fc_naive =NN_test_W$fc_naive)
# merge dataset as the daysprior format
result_test_NN_W <- fc_hw_daysprior(3,"additive") %>% select(c("stay_date","CONF_DT","forecast_period") )%>% left_join(result_test_W1, by = c("stay_date","CONF_DT")) %>% na.omit() %>% cbind(hotel="WARUK")
# calculate NN models errors
nn_result_out_W<- result_test_NN_W %>%
group_by(forecast_period) %>%
# MAE error measurements
summarise( MAE_nn = sum(abs(actual-fc_nn))/n(),
MAE_naive = sum(abs(actual-fc_naive))/n(),
# MAPE error measurements
MAPE_nn = sum(abs(actual-fc_nn)/actual)/n(),
# MASE error measurements compared to naive model
MASE_nn = MAE_nn/MAE_naive)
nn_result_out_W<-txtRound(nn_result_out_W[,-1],2)
nn_result_out_W <- data.frame(forecast_period=fc_timestamp_out,nn_result_out_W)
htmlTable(nn_result_out_W)
| forecast_period | MAE_nn | MAE_naive | MAPE_nn | MASE_nn | |
|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 19.17 | 22.11 | 0.36 | 0.87 |
| 2 | 3m_Nov-Jan_out | 18.61 | 24.09 | 0.40 | 0.77 |
| 3 | 3m_Dec-Feb_out | 17.45 | 19.84 | 0.37 | 0.88 |
| 4 | 3m_Jan-Mar_out | 17.82 | 15.76 | 0.30 | 1.13 |
| 5 | 3m_Feb-Apr_out | 17.45 | 17.89 | 0.25 | 0.98 |
| 6 | 1m_Nov_out | 18.91 | 26.87 | 0.36 | 0.70 |
| 7 | 1m_Dec_out | 15.24 | 26.33 | 0.43 | 0.58 |
| 8 | 1m_Jan_out | 17.43 | 17.32 | 0.37 | 1.01 |
| 9 | 1m_Feb_out | 15.73 | 13.18 | 0.25 | 1.19 |
| 10 | 1m_Mar_out | 15.68 | 17.94 | 0.23 | 0.87 |
| 11 | 1m_Apr_out | 20.78 | 31.53 | 0.52 | 0.66 |
in_fitcompare_dataset <- function(hotelname,factor) {
# fit combined models to get coefficient from training data
fc1<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add","fc_hw_a",factor)
dataset1<-fc1$dataset
fc2<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_a",factor)
dataset2<-fc2$dataset
fc3<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_m",factor)
dataset3<-fc3$dataset
# store the combined model parameters as parameter datasets for later join with out-sample data
coe_fc_add.fc_hw_a <- dataset1[,c(1,which(names(dataset1) == factor),(ncol(dataset1)-2):ncol(dataset1))] %>% distinct()
coe_fc_add_mDOW.fc_hw_a <- dataset2[,c(1,which(names(dataset2) == factor),(ncol(dataset2)-2):ncol(dataset2))] %>% distinct()
coe_fc_add_mDOW.fc_hw_m <- dataset3[,c(1,which(names(dataset3) == factor),(ncol(dataset3)-2):ncol(dataset3))] %>% distinct()
# get out-sample forecast data using hw_additive and hw multiplicative model
if(hotelname == "GLWST") {
hotelno<-1
} else if (hotelname == "MLKEP") {
hotelno<-2
} else {
hotelno<-3}
# calculte the combined-fc result for in sample model
in_fitcompare_dataset<- in_compare_dataset %>%
# merge with the parameters dataset calculated from in sample dataset
merge(coe_fc_add.fc_hw_a, by = c("hotel",factor)) %>%
merge(coe_fc_add_mDOW.fc_hw_a, by = c("hotel",factor)) %>%
merge(coe_fc_add_mDOW.fc_hw_m, by = c("hotel",factor)) %>%
filter(days_prior!=0) %>% # filter out final_day forecast
# model combined fc_add and fc_hw_a
mutate(fc_add.fc_hw_a = interc.fc_add.fc_hw_a + coef1.fc_add.fc_hw_a*fc_add + coef2.fc_add.fc_hw_a*fc_hw_a ) %>%
# model combined fc_mDOW and fc_hw_a
mutate(fc_add_mDOW.fc_hw_a = interc.fc_add_mDOW.fc_hw_a + coef1.fc_add_mDOW.fc_hw_a*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_a *fc_hw_a ) %>%
# model combined fc_mDOW and fc_hw_m
mutate(fc_add_mDOW.fc_hw_m = interc.fc_add_mDOW.fc_hw_m + coef1.fc_add_mDOW.fc_hw_m*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_m *fc_hw_m ) %>% select(-(13:21)) # drop columns with the coefficient datas
# drop NA rows from the out compare dataset
in_fitcompare_dataset <- na.omit( in_fitcompare_dataset)
return(in_fitcompare_dataset)
}
# insample fc arrvials from NN model
NN_infc_dataset <- rbind(result_train_G,result_train_M,result_train_W)
# insample fc arrvials from Other models we use in combined models
Other_infc_dataset <- rbind(in_fitcompare_dataset("GLWST","DOW"),in_fitcompare_dataset("MLKEP","DOW"),in_fitcompare_dataset("WARUK","DOW"))
Other_infc_dataset2 <- rbind(in_fitcompare_dataset("GLWST","days_prior_c"),in_fitcompare_dataset("MLKEP","days_prior_c"),in_fitcompare_dataset("WARUK","days_prior_c"))
# merge fc from other models with the nn models
final_infc_dataset<- merge(Other_infc_dataset,Other_infc_dataset2,by= c(names(Other_infc_dataset[,-(13:15)])),suffixes=c("__DOW","__dpr")) %>% merge(NN_infc_dataset,by = c("stay_date","CONF_DT","hotel"))
names(final_infc_dataset)
## [1] "stay_date" "CONF_DT"
## [3] "hotel" "DOW"
## [5] "days_prior" "days_prior_c"
## [7] "final_arrivals" "fc_add_mDOW"
## [9] "fc_add" "fc_mul"
## [11] "fc_hw_a" "fc_hw_m"
## [13] "fc_add.fc_hw_a__DOW" "fc_add_mDOW.fc_hw_a__DOW"
## [15] "fc_add_mDOW.fc_hw_m__DOW" "fc_add.fc_hw_a__dpr"
## [17] "fc_add_mDOW.fc_hw_a__dpr" "fc_add_mDOW.fc_hw_m__dpr"
## [19] "fc_nn"
# outsample fc arrvials from NN model
NN_outfc_dataset <- rbind(result_test_NN_G,result_test_NN_M,result_test_NN_W) %>% select("stay_date","CONF_DT","hotel","fc_nn","forecast_period")
# outsample fc arrvials from Other models we use in combined models
Other_outfc_dataset <- rbind(out_compare_dataset("GLWST","DOW"),out_compare_dataset("MLKEP","DOW"),out_compare_dataset("WARUK","DOW"))
Other_outfc_dataset2 <- rbind(out_compare_dataset("GLWST","days_prior_c"),out_compare_dataset("MLKEP","days_prior_c"),out_compare_dataset("WARUK","days_prior_c"))
# merge fc from other models with the nn models
final_outfc_dataset<- merge(Other_outfc_dataset,Other_outfc_dataset2,by= c(names(Other_outfc_dataset[,-(16:18)])),suffixes=c("__DOW","__dpr")) %>% left_join(NN_outfc_dataset,by = c("stay_date","CONF_DT","hotel","forecast_period"))
essemble_result_error <- function(dataset) {
essemble_error_matix<- dataset %>%
group_by(forecast_period) %>%
# MAE error measurements
summarise(MAE_naive = sum(abs(final_arrivals-fc_naive))/n(),
MAE_add = sum(abs(final_arrivals-fc_add))/n(),
MAE_mul = sum(abs(final_arrivals-fc_mul))/n(),
MAE_add_mDOW = sum(abs(final_arrivals-fc_add_mDOW))/n(),
MAE_add.hw_a__DOW = sum(abs(final_arrivals-fc_add.fc_hw_a__DOW))/n(),
MAE_add_mDOW.hw_m__DOW = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__DOW))/n(),
MAE_add.hw_a__dpr = sum(abs(final_arrivals-fc_add.fc_hw_a__dpr))/n(),
MAE_add_mDOW.hw_a__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_a__dpr))/n(),
MAE_add_mDOW.hw_m__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__dpr))/n(),
MAE_nn = sum(abs(final_arrivals-fc_nn))/n(),
MAE_glm_st = sum(abs(final_arrivals-fc_glm_stacked))/n(),
# MAPE error measurements
MAPE_add = sum(abs(final_arrivals-fc_add)/abs(final_arrivals))/n(),
MAPE_mul = sum(abs(final_arrivals-fc_mul)/abs(final_arrivals))/n(),
MAPE_add_mDOW = sum(abs(final_arrivals-fc_add_mDOW)/abs(final_arrivals))/n(),
MAPE_add.hw_a__DOW = sum(abs(final_arrivals-fc_add.fc_hw_a__DOW)/abs(final_arrivals))/n(),
MAPE_add_mDOW.hw_m__DOW = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__DOW)/abs(final_arrivals))/n(),
MAPE_add.hw_a__dpr = sum(abs(final_arrivals-fc_add.fc_hw_a__dpr)/abs(final_arrivals))/n(),
MAPE_add_mDOW.hw_a__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_a__dpr)/abs(final_arrivals))/n(),
MAPE_add_mDOW.hw_m__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__dpr)/abs(final_arrivals))/n(),
MAPE_nn = sum(abs(final_arrivals-fc_nn)/abs(final_arrivals))/n(),
MAPE_glm_st = sum(abs(final_arrivals-fc_glm_stacked)/abs(final_arrivals))/n(),
# MASE error measurements compared to naive model
MASE_add = MAE_add/MAE_naive,
MASE_mul = MAE_mul/MAE_naive,
MASE_add_mDOW = MAE_add_mDOW/MAE_naive,
MASE_add.hw_a_DOW = MAE_add.hw_a__DOW/MAE_naive,
MASE_add_mDOW.hw_m__DOW = MAE_add_mDOW.hw_m__DOW/MAE_naive,
MASE_add.hw_a__dpr = MAE_add.hw_a__dpr/MAE_naive,
MASE_add_mDOW.hw_a__dpr = MAE_add_mDOW.hw_a__dpr/MAE_naive,
MASE_add_mDOW.hw_m__dpr = MAE_add_mDOW.hw_m__dpr/MAE_naive,
MASE_nn = MAE_nn/MAE_naive,
MASE_glm_st = MAE_glm_st/MAE_naive)
return(essemble_error_matix)
}
# Defining the training control
cvCtrl <- trainControl(method="repeatedcv", repeats=3)
nnetGrid <- expand.grid(size = seq(from = 1, to = 10, by = 1),
decay = seq(from = 0.1, to = 0.5, by = 0.1))
#Predictors for top layer models
final_infc_datase_G<-final_infc_dataset %>% filter(hotel == "GLWST")
predictors_top<-c('fc_add','fc_mul','fc_hw_a','fc_add_mDOW',"fc_add.fc_hw_a__DOW","fc_add_mDOW.fc_hw_a__DOW", "fc_add_mDOW.fc_hw_m__DOW","fc_add.fc_hw_a__dpr","fc_add_mDOW.fc_hw_a__dpr" ,"fc_add_mDOW.fc_hw_m__dpr","fc_nn")
outcomeName <- "final_arrivals"
#Neuralnet as top layer model
model_glm<-
train(final_infc_datase_G[,predictors_top],final_infc_datase_G[,outcomeName],
method='glm',trControl=cvCtrl,tuneLength=3)
#predict using GBM top layer model
final_outfc_dataset_G <- final_outfc_dataset %>% filter(hotel == "GLWST")
final_outfc_dataset_G$fc_glm_stacked<-predict(model_glm,final_outfc_dataset_G[,predictors_top])
# essemble data model result
essem_result_G<- essemble_result_error(final_outfc_dataset_G)
essem_result_G_com <- essem_result_G %>% select("MAE_glm_st","MAPE_glm_st","MASE_glm_st")
essem_result_G_com <- txtRound(essem_result_G_com,2)
essem_result_G_com <- data.frame(forecast_period = fc_timestamp_out,essem_result_G_com )
htmlTable(essem_result_G_com)
| forecast_period | MAE_glm_st | MAPE_glm_st | MASE_glm_st | |
|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 14.32 | 0.22 | 0.80 |
| 2 | 3m_Nov-Jan_out | 14.79 | 0.26 | 0.79 |
| 3 | 3m_Dec-Feb_out | 14.70 | 0.26 | 0.87 |
| 4 | 3m_Jan-Mar_out | 13.56 | 0.19 | 0.81 |
| 5 | 3m_Feb-Apr_out | 13.94 | 0.18 | 0.66 |
| 6 | 1m_Nov_out | 9.58 | 0.10 | 0.55 |
| 7 | 1m_Dec_out | 14.24 | 0.31 | 0.66 |
| 8 | 1m_Jan_out | 13.71 | 0.23 | 0.87 |
| 9 | 1m_Feb_out | 8.46 | 0.10 | 0.64 |
| 10 | 1m_Mar_out | 13.74 | 0.16 | 0.51 |
| 11 | 1m_Apr_out | 10.78 | 0.13 | 0.49 |
# MAE, MAPE, MASE result
essem_result_G_MAE <- essem_result_G[names(essem_result_G) %like% "MAE" | names(essem_result_G) == "forecast_period"]
essem_result_G_MAE
## # A tibble: 11 x 12
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_add.hw_a__D…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 17.9 21.9 49.3 17.3 20.7
## 2 3m_Nov-Jan_out 18.6 24.8 37.0 18.1 23.4
## 3 3m_Dec-Feb_out 16.9 22.7 37.3 15.8 24.1
## 4 3m_Jan-Mar_out 16.7 16.8 46.0 13.9 18.7
## 5 3m_Feb-Apr_out 21.0 14.5 40.1 14.7 14.1
## 6 1m_Nov_out 17.3 13.4 31.6 14.5 9.71
## 7 1m_Dec_out 21.4 15.4 25.2 13.4 17.9
## 8 1m_Jan_out 15.7 14.1 27.5 11.9 20.8
## 9 1m_Feb_out 13.2 11.4 24.1 11.3 12.8
## 10 1m_Mar_out 26.9 12.5 25.3 11.1 10.9
## 11 1m_Apr_out 22.2 13.1 34.7 10.5 11.9
## # … with 6 more variables: MAE_add_mDOW.hw_m__DOW <dbl>,
## # MAE_add.hw_a__dpr <dbl>, MAE_add_mDOW.hw_a__dpr <dbl>,
## # MAE_add_mDOW.hw_m__dpr <dbl>, MAE_nn <dbl>, MAE_glm_st <dbl>
essem_result_G_MAPE <- essem_result_G[names(essem_result_G) %like% "MAPE" | names(essem_result_G) == "forecast_period"]
essem_result_G_MAPE
## # A tibble: 11 x 11
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_add.hw_a__…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 0.374 0.520 0.269 0.368
## 2 3m_Nov-Jan_out 0.478 0.428 0.317 0.475
## 3 3m_Dec-Feb_out 0.440 0.476 0.278 0.480
## 4 3m_Jan-Mar_out 0.243 0.548 0.193 0.291
## 5 3m_Feb-Apr_out 0.178 0.436 0.183 0.177
## 6 1m_Nov_out 0.138 0.301 0.139 0.0998
## 7 1m_Dec_out 0.378 0.337 0.281 0.453
## 8 1m_Jan_out 0.271 0.418 0.192 0.417
## 9 1m_Feb_out 0.137 0.263 0.133 0.160
## 10 1m_Mar_out 0.133 0.274 0.128 0.119
## 11 1m_Apr_out 0.143 0.387 0.116 0.130
## # … with 6 more variables: MAPE_add_mDOW.hw_m__DOW <dbl>,
## # MAPE_add.hw_a__dpr <dbl>, MAPE_add_mDOW.hw_a__dpr <dbl>,
## # MAPE_add_mDOW.hw_m__dpr <dbl>, MAPE_nn <dbl>, MAPE_glm_st <dbl>
essem_result_G_MASE <- essem_result_G[names(essem_result_G) %like% "MASE" | names(essem_result_G) == "forecast_period"]
essem_result_G_MASE
## # A tibble: 11 x 11
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_add.hw_a_D…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.22 2.76 0.966 1.16
## 2 3m_Nov-Jan_out 1.33 1.98 0.973 1.25
## 3 3m_Dec-Feb_out 1.34 2.21 0.934 1.43
## 4 3m_Jan-Mar_out 1.01 2.76 0.837 1.12
## 5 3m_Feb-Apr_out 0.689 1.91 0.696 0.671
## 6 1m_Nov_out 0.774 1.82 0.838 0.560
## 7 1m_Dec_out 0.717 1.18 0.625 0.836
## 8 1m_Jan_out 0.894 1.75 0.757 1.32
## 9 1m_Feb_out 0.861 1.82 0.853 0.963
## 10 1m_Mar_out 0.463 0.938 0.414 0.404
## 11 1m_Apr_out 0.588 1.56 0.474 0.535
## # … with 6 more variables: MASE_add_mDOW.hw_m__DOW <dbl>,
## # MASE_add.hw_a__dpr <dbl>, MASE_add_mDOW.hw_a__dpr <dbl>,
## # MASE_add_mDOW.hw_m__dpr <dbl>, MASE_nn <dbl>, MASE_glm_st <dbl>
# Defining the training control
cvCtrl <- trainControl(method="repeatedcv", repeats=3)
nnetGrid <- expand.grid(size = seq(from = 1, to = 10, by = 1),
decay = seq(from = 0.1, to = 0.5, by = 0.1))
#Predictors for top layer models
final_infc_datase_M<-final_infc_dataset %>% filter(hotel == "MLKEP")
predictors_top<-c('fc_add','fc_mul','fc_hw_a','fc_add_mDOW',"fc_add.fc_hw_a__DOW","fc_add_mDOW.fc_hw_a__DOW", "fc_add_mDOW.fc_hw_m__DOW","fc_add.fc_hw_a__dpr","fc_add_mDOW.fc_hw_a__dpr" ,"fc_add_mDOW.fc_hw_m__dpr","fc_nn")
outcomeName <- "final_arrivals"
#Neuralnet as top layer model
model_glm<-
train(final_infc_datase_M[,predictors_top],final_infc_datase_M[,outcomeName],
method='glm',trControl=cvCtrl,tuneLength=3)
#predict using GBM top layer model
final_outfc_dataset_M <- final_outfc_dataset %>% filter(hotel == "MLKEP")
final_outfc_dataset_M$fc_glm_stacked<-predict(model_glm,final_outfc_dataset_M[,predictors_top])
# essemble data model result
essem_result_M<- essemble_result_error(final_outfc_dataset_M)
essem_result_M_com <- essem_result_M %>% select("MAE_glm_st","MAPE_glm_st","MASE_glm_st")
essem_result_M_com <- txtRound(essem_result_M_com,2)
essem_result_M_com <- data.frame(forecast_period = fc_timestamp_out,essem_result_M_com )
htmlTable(essem_result_M_com)
| forecast_period | MAE_glm_st | MAPE_glm_st | MASE_glm_st | |
|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 24.12 | 0.49 | 1.21 |
| 2 | 3m_Nov-Jan_out | 24.34 | 0.51 | 1.24 |
| 3 | 3m_Dec-Feb_out | 24.92 | 0.52 | 1.30 |
| 4 | 3m_Jan-Mar_out | 19.22 | 0.30 | 1.18 |
| 5 | 3m_Feb-Apr_out | 17.74 | 0.25 | 1.10 |
| 6 | 1m_Nov_out | 13.32 | 0.15 | 0.64 |
| 7 | 1m_Dec_out | 28.83 | 0.75 | 1.43 |
| 8 | 1m_Jan_out | 20.68 | 0.40 | 1.24 |
| 9 | 1m_Feb_out | 11.85 | 0.14 | 0.86 |
| 10 | 1m_Mar_out | 17.41 | 0.22 | 1.02 |
| 11 | 1m_Apr_out | 14.76 | 0.22 | 0.62 |
# MAE, MAPE, MASE result
essem_result_M_MAE <- essem_result_M[names(essem_result_M) %like% "MAE" | names(essem_result_M) == "forecast_period"]
essem_result_M_MAE
## # A tibble: 11 x 12
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_add.hw_a__D…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 19.9 42.9 51.2 25.0 30.1
## 2 3m_Nov-Jan_out 19.6 44.3 52.7 25.3 31.1
## 3 3m_Dec-Feb_out 19.2 40.5 48.8 26.3 27.5
## 4 3m_Jan-Mar_out 16.2 39.6 58.5 18.1 21.2
## 5 3m_Feb-Apr_out 16.2 37.9 62.5 14.9 19.0
## 6 1m_Nov_out 20.7 37.0 38.4 14.0 25.0
## 7 1m_Dec_out 20.2 35.6 26.5 29.2 33.0
## 8 1m_Jan_out 16.7 39.1 40.9 20.3 25.3
## 9 1m_Feb_out 13.8 31.3 33.6 9.83 14.5
## 10 1m_Mar_out 17.1 31.4 35.3 13.5 15.4
## 11 1m_Apr_out 24 34.3 34.3 12.9 16.1
## # … with 6 more variables: MAE_add_mDOW.hw_m__DOW <dbl>,
## # MAE_add.hw_a__dpr <dbl>, MAE_add_mDOW.hw_a__dpr <dbl>,
## # MAE_add_mDOW.hw_m__dpr <dbl>, MAE_nn <dbl>, MAE_glm_st <dbl>
essem_result_M_MAPE <- essem_result_M[names(essem_result_M) %like% "MAPE" | names(essem_result_M) == "forecast_period"]
essem_result_M_MAPE
## # A tibble: 11 x 11
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_add.hw_a__…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 0.741 0.652 0.439 0.581
## 2 3m_Nov-Jan_out 0.761 0.680 0.458 0.615
## 3 3m_Dec-Feb_out 0.783 0.571 0.503 0.600
## 4 3m_Jan-Mar_out 0.597 0.510 0.229 0.290
## 5 3m_Feb-Apr_out 0.533 0.610 0.194 0.260
## 6 1m_Nov_out 0.371 0.334 0.126 0.263
## 7 1m_Dec_out 0.765 0.442 0.679 0.835
## 8 1m_Jan_out 0.746 0.365 0.295 0.401
## 9 1m_Feb_out 0.406 0.344 0.114 0.182
## 10 1m_Mar_out 0.388 0.358 0.159 0.157
## 11 1m_Apr_out 0.433 0.368 0.156 0.199
## # … with 6 more variables: MAPE_add_mDOW.hw_m__DOW <dbl>,
## # MAPE_add.hw_a__dpr <dbl>, MAPE_add_mDOW.hw_a__dpr <dbl>,
## # MAPE_add_mDOW.hw_m__dpr <dbl>, MAPE_nn <dbl>, MAPE_glm_st <dbl>
essem_result_M_MASE <- essem_result_M[names(essem_result_M) %like% "MASE" | names(essem_result_M) == "forecast_period"]
essem_result_M_MASE
## # A tibble: 11 x 11
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_add.hw_a_D…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 2.16 2.58 1.26 1.51
## 2 3m_Nov-Jan_out 2.25 2.68 1.29 1.58
## 3 3m_Dec-Feb_out 2.11 2.54 1.37 1.43
## 4 3m_Jan-Mar_out 2.44 3.61 1.12 1.31
## 5 3m_Feb-Apr_out 2.34 3.86 0.922 1.17
## 6 1m_Nov_out 1.79 1.86 0.678 1.21
## 7 1m_Dec_out 1.76 1.31 1.45 1.63
## 8 1m_Jan_out 2.35 2.45 1.22 1.52
## 9 1m_Feb_out 2.27 2.44 0.715 1.06
## 10 1m_Mar_out 1.83 2.06 0.786 0.897
## 11 1m_Apr_out 1.43 1.43 0.537 0.671
## # … with 6 more variables: MASE_add_mDOW.hw_m__DOW <dbl>,
## # MASE_add.hw_a__dpr <dbl>, MASE_add_mDOW.hw_a__dpr <dbl>,
## # MASE_add_mDOW.hw_m__dpr <dbl>, MASE_nn <dbl>, MASE_glm_st <dbl>
# Defining the training control
cvCtrl <- trainControl(method="repeatedcv", repeats=3)
nnetGrid <- expand.grid(size = seq(from = 1, to = 10, by = 1),
decay = seq(from = 0.1, to = 0.5, by = 0.1))
#Predictors for top layer models
final_infc_datase_W<-final_infc_dataset %>% filter(hotel == "WARUK")
predictors_top<-c('fc_add','fc_mul','fc_hw_a','fc_add_mDOW',"fc_add.fc_hw_a__DOW","fc_add_mDOW.fc_hw_a__DOW", "fc_add_mDOW.fc_hw_m__DOW","fc_add.fc_hw_a__dpr","fc_add_mDOW.fc_hw_a__dpr" ,"fc_add_mDOW.fc_hw_m__dpr","fc_nn")
outcomeName <- "final_arrivals"
#Neuralnet as top layer model
model_glm<-
train(final_infc_datase_G[,predictors_top],final_infc_datase_G[,outcomeName],
method='glm',trControl=cvCtrl,tuneLength=3)
#predict using GBM top layer model
final_outfc_dataset_W <- final_outfc_dataset %>% filter(hotel == "WARUK")
final_outfc_dataset_W$fc_glm_stacked<-predict(model_glm,final_outfc_dataset_W[,predictors_top])
# essemble data model result
essem_result_W<- essemble_result_error(final_outfc_dataset_W)
essem_result_W_com <- essem_result_W %>% select("MAE_glm_st","MAPE_glm_st","MASE_glm_st")
essem_result_W_com <- txtRound(essem_result_W[-1],2)
essem_result_W_com <- data.frame(forecast_period = fc_timestamp_out,essem_result_W_com )
htmlTable(essem_result_W_com)
| forecast_period | MAE_naive | MAE_add | MAE_mul | MAE_add_mDOW | MAE_add.hw_a__DOW | MAE_add_mDOW.hw_m__DOW | MAE_add.hw_a__dpr | MAE_add_mDOW.hw_a__dpr | MAE_add_mDOW.hw_m__dpr | MAE_nn | MAE_glm_st | MAPE_add | MAPE_mul | MAPE_add_mDOW | MAPE_add.hw_a__DOW | MAPE_add_mDOW.hw_m__DOW | MAPE_add.hw_a__dpr | MAPE_add_mDOW.hw_a__dpr | MAPE_add_mDOW.hw_m__dpr | MAPE_nn | MAPE_glm_st | MASE_add | MASE_mul | MASE_add_mDOW | MASE_add.hw_a_DOW | MASE_add_mDOW.hw_m__DOW | MASE_add.hw_a__dpr | MASE_add_mDOW.hw_a__dpr | MASE_add_mDOW.hw_m__dpr | MASE_nn | MASE_glm_st | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 6m_Nov-Apr_out | 22.30 | 32.83 | 33.31 | 17.97 | 21.18 | 17.73 | 24.37 | 17.84 | 17.98 | 19.34 | 26.60 | 1.05 | 0.54 | 0.46 | 0.64 | 0.45 | 0.67 | 0.45 | 0.46 | 0.37 | 0.64 | 1.47 | 1.49 | 0.81 | 0.95 | 0.79 | 1.09 | 0.80 | 0.81 | 0.87 | 1.19 |
| 2 | 3m_Nov-Jan_out | 24.09 | 34.49 | 29.90 | 18.05 | 21.81 | 17.75 | 24.60 | 17.94 | 18.07 | 18.61 | 26.44 | 1.20 | 0.55 | 0.51 | 0.72 | 0.51 | 0.76 | 0.51 | 0.51 | 0.40 | 0.70 | 1.43 | 1.24 | 0.75 | 0.91 | 0.74 | 1.02 | 0.74 | 0.75 | 0.77 | 1.10 |
| 3 | 3m_Dec-Feb_out | 19.84 | 32.04 | 32.35 | 16.58 | 22.97 | 16.42 | 23.20 | 16.69 | 16.64 | 17.45 | 27.64 | 1.14 | 0.61 | 0.51 | 0.77 | 0.50 | 0.79 | 0.52 | 0.51 | 0.37 | 0.74 | 1.61 | 1.63 | 0.84 | 1.16 | 0.83 | 1.17 | 0.84 | 0.84 | 0.88 | 1.39 |
| 4 | 3m_Jan-Mar_out | 15.76 | 26.28 | 39.03 | 14.03 | 16.37 | 13.83 | 22.84 | 13.88 | 14.10 | 17.82 | 33.82 | 0.74 | 0.57 | 0.27 | 0.38 | 0.26 | 0.33 | 0.26 | 0.27 | 0.30 | 0.81 | 1.67 | 2.48 | 0.89 | 1.04 | 0.88 | 1.45 | 0.88 | 0.89 | 1.13 | 2.15 |
| 5 | 3m_Feb-Apr_out | 17.89 | 22.29 | 31.97 | 16.26 | 14.53 | 16.20 | 16.57 | 16.14 | 16.30 | 17.45 | 26.17 | 0.50 | 0.43 | 0.25 | 0.24 | 0.25 | 0.27 | 0.25 | 0.25 | 0.25 | 0.51 | 1.25 | 1.79 | 0.91 | 0.81 | 0.91 | 0.93 | 0.90 | 0.91 | 0.98 | 1.46 |
| 6 | 1m_Nov_out | 26.87 | 26.94 | 28.53 | 14.98 | 11.92 | 14.71 | 21.02 | 15.16 | 15.25 | 18.91 | 19.91 | 0.67 | 0.44 | 0.30 | 0.26 | 0.30 | 0.41 | 0.31 | 0.31 | 0.36 | 0.48 | 1.00 | 1.06 | 0.56 | 0.44 | 0.55 | 0.78 | 0.56 | 0.57 | 0.70 | 0.74 |
| 7 | 1m_Dec_out | 26.33 | 28.37 | 23.41 | 18.94 | 24.70 | 18.85 | 22.80 | 19.02 | 18.96 | 15.24 | 22.56 | 1.14 | 0.59 | 0.71 | 0.98 | 0.71 | 0.92 | 0.73 | 0.72 | 0.43 | 0.66 | 1.08 | 0.89 | 0.72 | 0.94 | 0.72 | 0.87 | 0.72 | 0.72 | 0.58 | 0.86 |
| 8 | 1m_Jan_out | 17.32 | 27.76 | 28.94 | 9.07 | 15.06 | 8.71 | 18.00 | 9.09 | 9.16 | 17.43 | 37.05 | 0.96 | 0.51 | 0.26 | 0.48 | 0.24 | 0.34 | 0.26 | 0.27 | 0.37 | 1.14 | 1.60 | 1.67 | 0.52 | 0.87 | 0.50 | 1.04 | 0.53 | 0.53 | 1.01 | 2.14 |
| 9 | 1m_Feb_out | 13.18 | 20.78 | 22.83 | 14.03 | 13.62 | 13.77 | 15.52 | 14.13 | 14.21 | 15.73 | 24.62 | 0.49 | 0.33 | 0.24 | 0.23 | 0.23 | 0.27 | 0.24 | 0.24 | 0.25 | 0.49 | 1.58 | 1.73 | 1.06 | 1.03 | 1.04 | 1.18 | 1.07 | 1.08 | 1.19 | 1.87 |
| 10 | 1m_Mar_out | 17.94 | 19.86 | 25.54 | 12.53 | 13.58 | 12.89 | 12.86 | 12.35 | 12.41 | 15.68 | 26.26 | 0.43 | 0.35 | 0.19 | 0.22 | 0.20 | 0.22 | 0.18 | 0.18 | 0.23 | 0.56 | 1.11 | 1.42 | 0.70 | 0.76 | 0.72 | 0.72 | 0.69 | 0.69 | 0.87 | 1.46 |
| 11 | 1m_Apr_out | 31.53 | 22.33 | 27.60 | 17.32 | 14.54 | 17.12 | 13.44 | 17.56 | 17.79 | 20.78 | 19.90 | 0.72 | 0.41 | 0.45 | 0.46 | 0.44 | 0.41 | 0.46 | 0.47 | 0.52 | 0.50 | 0.71 | 0.88 | 0.55 | 0.46 | 0.54 | 0.43 | 0.56 | 0.56 | 0.66 | 0.63 |
# MAE, MAPE, MASE result
essem_result_W_MAE <- essem_result_W[names(essem_result_W) %like% "MAE" | names(essem_result_W) == "forecast_period"]
essem_result_W_MAE
## # A tibble: 11 x 12
## forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_add.hw_a__D…
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 22.3 32.8 33.3 18.0 21.2
## 2 3m_Nov-Jan_out 24.1 34.5 29.9 18.0 21.8
## 3 3m_Dec-Feb_out 19.8 32.0 32.4 16.6 23.0
## 4 3m_Jan-Mar_out 15.8 26.3 39.0 14.0 16.4
## 5 3m_Feb-Apr_out 17.9 22.3 32.0 16.3 14.5
## 6 1m_Nov_out 26.9 26.9 28.5 15.0 11.9
## 7 1m_Dec_out 26.3 28.4 23.4 18.9 24.7
## 8 1m_Jan_out 17.3 27.8 28.9 9.07 15.1
## 9 1m_Feb_out 13.2 20.8 22.8 14.0 13.6
## 10 1m_Mar_out 17.9 19.9 25.5 12.5 13.6
## 11 1m_Apr_out 31.5 22.3 27.6 17.3 14.5
## # … with 6 more variables: MAE_add_mDOW.hw_m__DOW <dbl>,
## # MAE_add.hw_a__dpr <dbl>, MAE_add_mDOW.hw_a__dpr <dbl>,
## # MAE_add_mDOW.hw_m__dpr <dbl>, MAE_nn <dbl>, MAE_glm_st <dbl>
essem_result_W_MAPE <- essem_result_W[names(essem_result_W) %like% "MAPE" | names(essem_result_W) == "forecast_period"]
essem_result_W_MAPE
## # A tibble: 11 x 11
## forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_add.hw_a__…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.05 0.537 0.461 0.636
## 2 3m_Nov-Jan_out 1.20 0.548 0.515 0.721
## 3 3m_Dec-Feb_out 1.14 0.606 0.505 0.769
## 4 3m_Jan-Mar_out 0.738 0.565 0.266 0.380
## 5 3m_Feb-Apr_out 0.500 0.432 0.250 0.241
## 6 1m_Nov_out 0.668 0.437 0.304 0.264
## 7 1m_Dec_out 1.14 0.586 0.713 0.980
## 8 1m_Jan_out 0.959 0.515 0.257 0.476
## 9 1m_Feb_out 0.494 0.326 0.237 0.233
## 10 1m_Mar_out 0.431 0.346 0.190 0.217
## 11 1m_Apr_out 0.720 0.408 0.446 0.462
## # … with 6 more variables: MAPE_add_mDOW.hw_m__DOW <dbl>,
## # MAPE_add.hw_a__dpr <dbl>, MAPE_add_mDOW.hw_a__dpr <dbl>,
## # MAPE_add_mDOW.hw_m__dpr <dbl>, MAPE_nn <dbl>, MAPE_glm_st <dbl>
essem_result_W_MASE <- essem_result_W[names(essem_result_W) %like% "MASE" | names(essem_result_W) == "forecast_period"]
essem_result_W_MASE
## # A tibble: 11 x 11
## forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_add.hw_a_D…
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6m_Nov-Apr_out 1.47 1.49 0.806 0.950
## 2 3m_Nov-Jan_out 1.43 1.24 0.749 0.905
## 3 3m_Dec-Feb_out 1.61 1.63 0.836 1.16
## 4 3m_Jan-Mar_out 1.67 2.48 0.890 1.04
## 5 3m_Feb-Apr_out 1.25 1.79 0.909 0.812
## 6 1m_Nov_out 1.00 1.06 0.558 0.444
## 7 1m_Dec_out 1.08 0.889 0.719 0.938
## 8 1m_Jan_out 1.60 1.67 0.524 0.870
## 9 1m_Feb_out 1.58 1.73 1.06 1.03
## 10 1m_Mar_out 1.11 1.42 0.699 0.757
## 11 1m_Apr_out 0.708 0.875 0.549 0.461
## # … with 6 more variables: MASE_add_mDOW.hw_m__DOW <dbl>,
## # MASE_add.hw_a__dpr <dbl>, MASE_add_mDOW.hw_a__dpr <dbl>,
## # MASE_add_mDOW.hw_m__dpr <dbl>, MASE_nn <dbl>, MASE_glm_st <dbl>
# calculate final errors across all models
ts_models_result <- fc_result_across2(1,7,1,2,3,1,1,3,1,1)
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible
#MAE
## merge data set
final_result_MAE<- essem_result_G_MAE %>% merge(ts_models_result$MAE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MAE) <- sub("MAE_", "", names(final_result_MAE))
final_result_MAE_G<- cbind(final_result_MAE,best_model = colnames(final_result_MAE)[apply(final_result_MAE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MAE_G
## forecast_period naive add mul add_mDOW add.hw_a__DOW
## 1 1m_Apr_out 22.20000 13.06108 34.70481 10.51667 11.887041
## 2 1m_Dec_out 21.41935 15.35290 25.21525 13.38387 17.908469
## 3 1m_Feb_out 13.25000 11.41335 24.12291 11.30357 12.757344
## 4 1m_Jan_out 15.74194 14.07709 27.54339 11.91290 20.826753
## 5 1m_Mar_out 26.93548 12.46554 25.27108 11.14355 10.877600
## 6 1m_Nov_out 17.33333 13.42362 31.60142 14.52333 9.711472
## 7 3m_Dec-Feb_out 16.89535 22.69692 37.27439 15.78391 24.142969
## 8 3m_Feb-Apr_out 21.04706 14.50434 40.13171 14.65765 14.130302
## 9 3m_Jan-Mar_out 16.65432 16.76325 45.99757 13.94280 18.659585
## 10 3m_Nov-Jan_out 18.63953 24.75635 36.99013 18.12752 23.351970
## 11 6m_Nov-Apr_out 17.86466 21.87554 49.30405 17.26040 20.661638
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 10.16677 12.37197 9.927907 9.89106
## 2 13.33790 17.15965 13.860042 13.85507
## 3 12.03296 10.92530 10.645621 10.57431
## 4 14.01648 19.86036 12.580192 12.48519
## 5 11.04989 12.36155 11.860564 11.99706
## 6 12.26325 11.30977 12.227966 12.19327
## 7 17.32000 24.88309 17.286065 17.28694
## 8 15.09604 14.97061 14.902625 14.87846
## 9 14.98243 19.13512 14.624365 14.58278
## 10 18.22111 25.29510 18.465072 18.46853
## 11 17.17975 22.09557 17.310908 17.31893
## nn glm_st ses holt hw_add hw_mul Arima
## 1 12.96920 10.776718 20.98610 21.30267 24.28184 24.55066 18.21139
## 2 17.08721 14.239165 31.91392 31.88626 30.40857 30.03456 31.61924
## 3 10.55889 8.456728 22.95372 20.46945 17.53358 19.02115 18.84691
## 4 14.65335 13.712044 23.07441 22.93960 36.65615 33.55495 27.41032
## 5 18.15283 13.741970 23.50660 23.66548 18.45737 20.02641 22.20607
## 6 11.68395 9.576661 17.12180 17.26091 11.89435 12.17564 17.19369
## 7 15.24400 14.696027 31.32584 31.26093 31.17146 30.20617 33.11938
## 8 14.86698 13.936617 23.26497 24.07563 20.84123 18.11542 23.47816
## 9 15.76304 13.556182 23.17962 23.73684 24.72472 21.86841 23.72852
## 10 15.00711 14.788356 34.69838 35.46322 28.91156 29.40811 34.71262
## 11 14.83933 14.321916 29.56734 30.70201 24.39895 24.82579 29.57394
## Sarima best_model
## 1 19.75689 add_mDOW.hw_m__dpr
## 2 29.74818 add_mDOW.hw_m__DOW
## 3 27.91918 glm_st
## 4 26.51960 add_mDOW
## 5 20.69215 add.hw_a__DOW
## 6 12.90527 glm_st
## 7 30.86518 glm_st
## 8 40.46131 glm_st
## 9 21.85138 glm_st
## 10 31.62772 glm_st
## 11 27.44858 glm_st
#MAPE
## merge data set
final_result_MAPE<- essem_result_G_MAPE %>% merge(ts_models_result$MAPE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MAPE) <- sub("MAPE_", "", names(final_result_MAPE))
final_result_MAPE_G<- cbind(final_result_MAPE,best_model = colnames(final_result_MAPE)[apply(final_result_MAPE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MAPE_G
## forecast_period add mul add_mDOW add.hw_a__DOW
## 1 1m_Apr_out 0.1429668 0.3865512 0.1164103 0.13022332
## 2 1m_Dec_out 0.3782387 0.3368843 0.2805855 0.45320564
## 3 1m_Feb_out 0.1368193 0.2626456 0.1326880 0.16009835
## 4 1m_Jan_out 0.2711512 0.4183953 0.1924475 0.41683715
## 5 1m_Mar_out 0.1334998 0.2739222 0.1278081 0.11854726
## 6 1m_Nov_out 0.1382817 0.3013144 0.1391170 0.09984788
## 7 3m_Dec-Feb_out 0.4395241 0.4755764 0.2782206 0.47974361
## 8 3m_Feb-Apr_out 0.1781838 0.4356191 0.1826920 0.17677970
## 9 3m_Jan-Mar_out 0.2433534 0.5479933 0.1930591 0.29146873
## 10 3m_Nov-Jan_out 0.4775215 0.4283792 0.3172154 0.47523833
## 11 6m_Nov-Apr_out 0.3739208 0.5195538 0.2690731 0.36822186
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 0.1154576 0.1495960 0.1172223 0.1165691
## 2 0.3223653 0.4416610 0.3238922 0.3224881
## 3 0.1496584 0.1294508 0.1300352 0.1291818
## 4 0.2656145 0.3956618 0.2356513 0.2328658
## 5 0.1301427 0.1347771 0.1371939 0.1383336
## 6 0.1198128 0.1192571 0.1184087 0.1181872
## 7 0.3270118 0.4939610 0.3251485 0.3246142
## 8 0.1937959 0.1836680 0.1899267 0.1894483
## 9 0.2258745 0.3001093 0.2187653 0.2175639
## 10 0.3429870 0.5049113 0.3441311 0.3444060
## 11 0.2852307 0.3926099 0.2858660 0.2860877
## nn glm_st ses holt hw_add hw_mul Arima
## 1 0.1629093 0.12646821 0.2778388 0.2819059 0.3053951 0.3060608 0.2365036
## 2 0.3423986 0.31254098 0.6757493 0.6750160 0.6878321 0.6715978 0.7040996
## 3 0.1335015 0.10334368 0.3156966 0.2174224 0.1833935 0.1945147 0.1937591
## 4 0.2470143 0.23376262 0.4614499 0.4567448 0.7486518 0.6932201 0.5551548
## 5 0.2295949 0.16460193 0.2679289 0.2683444 0.2129133 0.2262414 0.2550257
## 6 0.1339989 0.09851609 0.1985084 0.2005270 0.1286130 0.1328571 0.1990354
## 7 0.2542332 0.26187296 0.5987116 0.5973831 0.6116655 0.5924527 0.6451855
## 8 0.1818107 0.17523941 0.2405159 0.2452765 0.2081257 0.2121346 0.2369889
## 9 0.2115929 0.19250517 0.3181623 0.3190124 0.4175608 0.3419958 0.3509090
## 10 0.2464093 0.25958654 0.6701037 0.6845672 0.5722553 0.5808797 0.6701543
## 11 0.2108836 0.22211498 0.5061138 0.5241845 0.4202772 0.4277763 0.5061296
## Sarima best_model
## 1 0.2399248 add_mDOW.hw_m__DOW
## 2 0.6860186 add_mDOW
## 3 0.2873494 glm_st
## 4 0.5487885 add_mDOW
## 5 0.2202115 add.hw_a__DOW
## 6 0.1439459 glm_st
## 7 0.6084707 nn
## 8 0.3985930 glm_st
## 9 0.3231854 glm_st
## 10 0.6187564 nn
## 11 0.4670655 nn
#MASE
## merge data set
final_result_MASE<- essem_result_G_MASE %>% merge(ts_models_result$MASE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MASE) <- sub("MASE_", "", names(final_result_MASE))
final_result_MASE_G<- cbind(final_result_MASE,best_model = colnames(final_result_MASE)[apply(final_result_MASE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MASE_G
## forecast_period add mul add_mDOW add.hw_a_DOW
## 1 1m_Apr_out 0.5883370 1.5632797 0.4737237 0.5354523
## 2 1m_Dec_out 0.7167769 1.1772178 0.6248494 0.8360882
## 3 1m_Feb_out 0.8613848 1.8205968 0.8530997 0.9628184
## 4 1m_Jan_out 0.8942414 1.7496829 0.7567623 1.3230109
## 5 1m_Mar_out 0.4627924 0.9382079 0.4137126 0.4038391
## 6 1m_Nov_out 0.7744395 1.8231591 0.8378846 0.5602773
## 7 3m_Dec-Feb_out 1.3433830 2.2061925 0.9342166 1.4289713
## 8 3m_Feb-Apr_out 0.6891388 1.9067610 0.6964226 0.6713671
## 9 3m_Jan-Mar_out 1.0065405 2.7618999 0.8371880 1.1204050
## 10 3m_Nov-Jan_out 1.3281637 1.9844983 0.9725307 1.2528193
## 11 6m_Nov-Apr_out 1.2245145 2.7598645 0.9661756 1.1565648
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 0.4579628 0.5572958 0.4472030 0.4455432
## 2 0.6227033 0.8011284 0.6470803 0.6468482
## 3 0.9081479 0.8245508 0.8034431 0.7980608
## 4 0.8903909 1.2616210 0.7991515 0.7931164
## 5 0.4102355 0.4589317 0.4403323 0.4453998
## 6 0.7074951 0.6524866 0.7054596 0.7034579
## 7 1.0251341 1.4727776 1.0231257 1.0231776
## 8 0.7172519 0.7112924 0.7080621 0.7069138
## 9 0.8996119 1.1489582 0.8781124 0.8756152
## 10 0.9775517 1.3570669 0.9906402 0.9908258
## 11 0.9616610 1.2368313 0.9690028 0.9694519
## nn glm_st ses holt
## 1 0.5841980 0.4854377 0.945319629121382 0.959579656671636
## 2 0.7977463 0.6647803 1.4899569826427 1.48866583852698
## 3 0.7968974 0.6382436 0.945153313792086 0.842859605534413
## 4 0.9308479 0.8710520 1.46579268309207 1.45722866851363
## 5 0.6739373 0.5101809 0.872700225739768 0.878598827909082
## 6 0.6740738 0.5524997 0.987796146118206 0.995821556838069
## 7 0.9022601 0.8698268 1.85116595265857 1.8473298401296
## 8 0.7063686 0.6621646 1.10608052462494 1.14462111892475
## 9 0.9464832 0.8139738 1.23150299808857 1.26110703952513
## 10 0.8051224 0.7933865 1.90924101308585 1.95132532723337
## 11 0.8306529 0.8016898 1.51007031723736 1.56802032878809
## hw_add hw_mul Arima Sarima
## 1 1.09377652193263 1.10588551357609 0.820333077007016 0.889950128449772
## 2 1.41967708388251 1.40221584981471 1.47619952475317 1.38884559083622
## 3 0.721970880917249 0.783223727928355 0.776049052871373 1.14961313559584
## 4 2.32856705580899 2.13156450930606 1.74122909332112 1.68464703480619
## 5 0.685243730902185 0.743495441486405 0.824417090624261 0.768211656516521
## 6 0.686212323034542 0.702440627424316 0.991943628166903 0.744534984540394
## 7 1.84204320025238 1.78500014535895 1.95715290376984 1.82394341546168
## 8 0.990849252153732 0.86125672682618 1.11621591854316 1.92364140046507
## 9 1.31359172056293 1.16183997927205 1.20653480890996 1.16093541521193
## 10 1.59082739119975 1.61814948410176 1.91002470655003 1.7402813646935
## 11 1.24610869159936 1.2679087638248 1.51040716122949 1.40186015810188
## best_model
## 1 add_mDOW.hw_m__dpr
## 2 add_mDOW.hw_m__DOW
## 3 glm_st
## 4 add_mDOW
## 5 add.hw_a_DOW
## 6 glm_st
## 7 glm_st
## 8 glm_st
## 9 glm_st
## 10 glm_st
## 11 glm_st
write.csv(final_result_MASE_G,"final_result_comp_G")
# calculate final errors across all models
ts_models_result <- fc_result_across2(2,1,0,21,7,0,0,0,1,2)
#MAE
## merge data set
final_result_MAE<- essem_result_M_MAE %>% merge(ts_models_result$MAE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MAE) <- sub("MAE_", "", names(final_result_MAE))
final_result_MAE_M<- cbind(final_result_MAE,best_model = colnames(final_result_MAE)[apply(final_result_MAE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MAE_M
## forecast_period naive add mul add_mDOW add.hw_a__DOW
## 1 1m_Apr_out 24.00000 34.29600 34.30023 12.886667 16.10522
## 2 1m_Dec_out 20.22581 35.59708 26.52085 29.243548 32.98638
## 3 1m_Feb_out 13.75000 31.25409 33.55669 9.830357 14.52931
## 4 1m_Jan_out 16.67742 39.11897 40.93420 20.347849 25.29573
## 5 1m_Mar_out 17.12903 31.42801 35.29458 13.467742 15.35815
## 6 1m_Nov_out 20.66667 36.98041 38.36482 14.020000 24.97409
## 7 3m_Dec-Feb_out 19.23438 40.49077 48.79043 26.302604 27.46416
## 8 3m_Feb-Apr_out 16.18987 37.94260 62.48388 14.928481 18.98788
## 9 3m_Jan-Mar_out 16.22989 39.55423 58.51588 18.125862 21.21792
## 10 3m_Nov-Jan_out 19.64615 44.29194 52.67898 25.343846 31.08961
## 11 6m_Nov-Apr_out 19.88000 42.93157 51.23970 25.024667 30.09904
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 15.07049 22.44991 12.13871 12.11192
## 2 30.62313 34.92467 30.15628 30.08645
## 3 11.12268 18.04567 10.21002 10.07657
## 4 20.97442 42.31960 19.27775 19.07814
## 5 19.39767 19.06837 14.56757 14.56943
## 6 13.19521 34.94039 13.92812 13.90476
## 7 28.48892 35.03181 27.10836 27.26329
## 8 18.11728 25.58060 15.48543 15.48311
## 9 19.83817 43.34432 18.33429 17.85886
## 10 25.88159 37.55638 25.77872 25.72166
## 11 26.43505 35.68508 25.60696 25.55507
## nn glm_st ses holt hw_add hw_mul Arima Sarima
## 1 21.57522 14.76040 41.47564 41.52681 28.07609 26.44477 39.06601 18.97741
## 2 30.09320 28.82892 53.11451 54.45684 41.05527 38.70986 36.91538 35.66195
## 3 18.43202 11.85082 41.83729 38.40744 13.61814 19.70531 32.10311 12.85905
## 4 27.42454 20.67671 47.38678 47.48135 63.69622 51.55298 49.19573 27.72846
## 5 17.98708 17.41475 43.19087 42.83800 19.74626 23.01562 37.41415 18.23914
## 6 17.50694 13.32408 51.26677 51.00898 49.68810 55.99825 49.04758 30.02807
## 7 28.07280 24.92036 50.00241 51.81970 33.81385 31.80701 40.87112 27.55973
## 8 18.60141 17.73710 41.25520 40.99548 19.07638 29.57399 40.47731 18.75691
## 9 21.14034 19.21548 50.20995 50.49698 72.18988 60.41168 44.87847 22.83732
## 10 20.10544 24.34446 47.99566 48.14022 43.31319 46.65270 47.67571 32.78799
## 11 20.20575 24.12081 45.49341 45.18002 40.44032 46.23437 44.91730 26.39705
## best_model
## 1 add_mDOW.hw_m__dpr
## 2 naive
## 3 add_mDOW
## 4 naive
## 5 add_mDOW
## 6 add_mDOW.hw_m__DOW
## 7 naive
## 8 add_mDOW
## 9 naive
## 10 naive
## 11 naive
#MAPE
## merge data set
final_result_MAPE<- essem_result_M_MAPE %>% merge(ts_models_result$MAPE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MAPE) <- sub("MAPE_", "", names(final_result_MAPE))
final_result_MAPE_M<- cbind(final_result_MAPE,best_model = colnames(final_result_MAPE)[apply(final_result_MAPE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MAPE_M
## forecast_period add mul add_mDOW add.hw_a__DOW
## 1 1m_Apr_out 0.4332157 0.3679176 0.1558879 0.1989811
## 2 1m_Dec_out 0.7648342 0.4424920 0.6785908 0.8350706
## 3 1m_Feb_out 0.4056351 0.3440712 0.1142073 0.1817685
## 4 1m_Jan_out 0.7456414 0.3647937 0.2950689 0.4010213
## 5 1m_Mar_out 0.3876549 0.3583283 0.1587225 0.1565653
## 6 1m_Nov_out 0.3707424 0.3342318 0.1264641 0.2631724
## 7 3m_Dec-Feb_out 0.7828847 0.5709631 0.5033322 0.6000072
## 8 3m_Feb-Apr_out 0.5326782 0.6095434 0.1940407 0.2600712
## 9 3m_Jan-Mar_out 0.5973462 0.5101751 0.2294766 0.2899782
## 10 3m_Nov-Jan_out 0.7610984 0.6804534 0.4575749 0.6147514
## 11 6m_Nov-Apr_out 0.7407662 0.6522311 0.4387032 0.5805509
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 0.1915750 0.2215381 0.1566331 0.1557490
## 2 0.7390915 0.8883674 0.7193455 0.7161831
## 3 0.1306672 0.1982841 0.1183823 0.1174266
## 4 0.2895283 0.5096766 0.2704740 0.2705025
## 5 0.2239462 0.2146204 0.1660411 0.1662154
## 6 0.1228266 0.2912530 0.1282773 0.1286706
## 7 0.5635657 0.8143111 0.5358372 0.5356415
## 8 0.2377737 0.3426794 0.2100627 0.2100062
## 9 0.2512083 0.4430607 0.2418531 0.2335547
## 10 0.4805846 0.5819343 0.4897794 0.4856837
## 11 0.4723618 0.5559612 0.4719063 0.4678413
## nn glm_st ses holt hw_add hw_mul Arima
## 1 0.3004774 0.2166164 0.6605126 0.6709377 0.3355028 0.2833986 0.4879097
## 2 0.6055824 0.7538441 1.1402568 1.1848696 1.0512742 0.9927841 0.6891902
## 3 0.2054740 0.1429029 0.6715170 0.5613361 0.1660205 0.1947078 0.3699352
## 4 0.3581943 0.3961542 0.7364310 0.7317912 0.9687336 0.5470016 0.8868399
## 5 0.2283115 0.2179621 0.5349947 0.5384868 0.1909887 0.2088241 0.3851852
## 6 0.1965561 0.1539777 0.4941932 0.4954742 0.4818548 0.4579445 0.4447614
## 7 0.4310866 0.5169085 1.1311959 1.2004435 0.8216322 0.7622298 0.7687634
## 8 0.2473512 0.2455036 0.5546310 0.5695227 0.2145234 0.2689125 0.4655955
## 9 0.2605080 0.2984885 0.5595839 0.5582343 0.9358860 0.5931100 0.6292966
## 10 0.3734373 0.5115623 0.7401124 0.7608638 0.5902200 0.5149623 0.7648333
## 11 0.3650814 0.4884624 0.6153640 0.6353902 0.5024606 0.4668452 0.6371228
## Sarima best_model
## 1 0.2418188 add_mDOW.hw_m__dpr
## 2 0.8870637 mul
## 3 0.1468516 add_mDOW
## 4 0.4678975 add_mDOW.hw_a__dpr
## 5 0.1734935 add.hw_a__DOW
## 6 0.2533241 add_mDOW.hw_m__DOW
## 7 0.6327700 nn
## 8 0.2054855 add_mDOW
## 9 0.2926796 add_mDOW
## 10 0.6012078 nn
## 11 0.4186814 nn
#MASE
## merge data set
final_result_MASE<- essem_result_M_MASE %>% merge(ts_models_result$MASE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MASE) <- sub("MASE_", "", names(final_result_MASE))
final_result_MASE_M<- cbind(final_result_MASE,best_model = colnames(final_result_MASE)[apply(final_result_MASE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MASE_M
## forecast_period add mul add_mDOW add.hw_a_DOW
## 1 1m_Apr_out 1.429000 1.429176 0.5369444 0.6710507
## 2 1m_Dec_out 1.759983 1.311238 1.4458533 1.6309057
## 3 1m_Feb_out 2.273025 2.440486 0.7149351 1.0566768
## 4 1m_Jan_out 2.345625 2.454468 1.2200838 1.5167655
## 5 1m_Mar_out 1.834780 2.060512 0.7862524 0.8966153
## 6 1m_Nov_out 1.789374 1.856362 0.6783871 1.2084237
## 7 3m_Dec-Feb_out 2.105125 2.536627 1.3674790 1.4278686
## 8 3m_Feb-Apr_out 2.343601 3.859442 0.9220876 1.1728247
## 9 3m_Jan-Mar_out 2.437123 3.605440 1.1168201 1.3073362
## 10 3m_Nov-Jan_out 2.254484 2.681389 1.2900157 1.5824784
## 11 6m_Nov-Apr_out 2.159536 2.577450 1.2587860 1.5140363
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 0.6279372 0.935413 0.5057795 0.5046634
## 2 1.5140621 1.726738 1.4909804 1.4875280
## 3 0.8089220 1.312413 0.7425470 0.7328416
## 4 1.2576535 2.537539 1.1559192 1.1439504
## 5 1.1324440 1.113219 0.8504609 0.8505692
## 6 0.6384777 1.690664 0.6739411 0.6728110
## 7 1.4811461 1.821313 1.4093702 1.4174254
## 8 1.1190502 1.580037 0.9564889 0.9563455
## 9 1.2223238 2.670649 1.1296623 1.1003690
## 10 1.3173870 1.911640 1.3121511 1.3092464
## 11 1.3297308 1.795024 1.2880763 1.2854663
## nn glm_st ses holt
## 1 0.8989675 0.6150168 1.72815186029591 1.73028354206183
## 2 1.4878613 1.4253533 2.62607600778802 2.69244325136226
## 3 1.3405104 0.8618777 0.676353494652262 0.620905457428594
## 4 1.6444117 1.2398029 2.84137377443743 2.84704398921894
## 5 1.0500931 1.0166803 2.52150109191934 2.50090002175195
## 6 0.8471098 0.6447135 2.48065023694255 2.46817641736297
## 7 1.4595120 1.2956159 2.94324218994747 3.05021113893062
## 8 1.1489534 1.0955675 2.24432329807167 2.23019396058413
## 9 1.3025565 1.1839567 3.15345143621606 3.17147789239688
## 10 1.0233779 1.2391465 2.50317495996648 2.51071420616879
## 11 1.0163857 1.2133206 2.42185488485271 2.40517140567444
## hw_add hw_mul Arima Sarima
## 1 1.16983687695675 1.101865510774 1.6277505250801 0.790725306183894
## 2 2.02984596452465 1.91388482490275 1.82516251706604 1.76319041440316
## 3 0.220154760923705 0.318561626986709 0.518987849397563 0.207882977134548
## 4 3.81930887153841 3.09118460927018 2.9498407151449 1.6626348866122
## 5 1.15279466596787 1.34366115083376 2.18425383977721 1.06480848108438
## 6 2.40426284125621 2.70959288322267 2.37327010250779 1.45297091409669
## 7 1.99035089593933 1.87222417169747 2.40575563848602 1.62222069380101
## 8 1.03777373155899 1.60885381507066 2.20200506717963 1.02039410524754
## 9 4.53390757349255 3.7941741061251 2.50135465975378 1.4343049976313
## 10 2.2589643205019 2.43313398617843 2.48648833358686 1.71003120065922
## 11 2.15285208085992 2.46130027007225 2.39118581025824 1.40525460249044
## best_model
## 1 add_mDOW.hw_m__dpr
## 2 mul
## 3 Sarima
## 4 add_mDOW.hw_m__dpr
## 5 add_mDOW
## 6 add_mDOW.hw_m__DOW
## 7 glm_st
## 8 add_mDOW
## 9 add_mDOW.hw_m__dpr
## 10 nn
## 11 nn
write.csv(final_result_MASE_M,"final_result_comp_M")
# calculate final errors across all models
ts_models_result <- fc_result_across2(3,6,1,1,8,0,1,2,1,1)
#MAE
## merge data set
final_result_MAE<- essem_result_W_MAE %>% merge(ts_models_result$MAE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MAE) <- sub("MAE_", "", names(final_result_MAE))
final_result_MAE_W<- cbind(final_result_MAE,best_model = colnames(final_result_MAE)[apply(final_result_MAE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MAE_W
## forecast_period naive add mul add_mDOW add.hw_a__DOW
## 1 1m_Apr_out 31.53333 22.32917 27.60060 17.321667 14.54373
## 2 1m_Dec_out 26.33333 28.37062 23.40607 18.940556 24.70162
## 3 1m_Feb_out 13.17857 20.77508 22.83339 14.026786 13.61632
## 4 1m_Jan_out 17.32258 27.75920 28.94381 9.069355 15.06433
## 5 1m_Mar_out 17.93548 19.86296 25.53842 12.532258 13.58167
## 6 1m_Nov_out 26.86667 26.93836 28.52750 14.983333 11.92449
## 7 3m_Dec-Feb_out 19.84211 32.04195 32.35332 16.580702 22.96913
## 8 3m_Feb-Apr_out 17.89231 22.29395 31.96535 16.261282 14.52545
## 9 3m_Jan-Mar_out 15.76316 26.28059 39.02560 14.030044 16.36903
## 10 3m_Nov-Jan_out 24.09412 34.49109 29.89735 18.045098 21.80822
## 11 6m_Nov-Apr_out 22.30189 32.82878 33.30804 17.971698 21.17808
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 17.121867 13.43937 17.564888 17.789071
## 2 18.853411 22.79862 19.023650 18.959991
## 3 13.768018 15.52205 14.131279 14.210231
## 4 8.711076 18.00321 9.094467 9.160284
## 5 12.887633 12.85754 12.346635 12.405454
## 6 14.712634 21.02283 15.156327 15.253281
## 7 16.416428 23.19741 16.688694 16.636309
## 8 16.203514 16.57054 16.142135 16.299754
## 9 13.833847 22.83670 13.875528 14.102389
## 10 17.749522 24.59625 17.942059 18.072414
## 11 17.725486 24.36981 17.844939 17.975440
## nn glm_st ses holt hw_add hw_mul Arima Sarima
## 1 20.78473 19.89984 27.20959 27.45437 17.78947 17.83321 23.82032 17.38110
## 2 15.24328 22.56056 31.30868 30.63154 30.23650 30.10730 26.51127 31.23456
## 3 15.72514 24.62324 25.39501 27.76141 16.25180 17.38830 20.49617 17.85865
## 4 17.43231 37.04820 26.23703 25.05556 21.53150 19.87277 26.10291 21.75883
## 5 15.67644 26.25895 23.27438 23.27199 15.59887 15.90344 18.25195 16.00217
## 6 18.91021 19.90526 30.12265 29.93947 19.17861 18.43681 27.26544 18.68239
## 7 17.45478 27.63661 30.47796 29.87686 23.55038 23.37988 27.62729 23.60316
## 8 17.45148 26.17255 27.11680 27.87490 17.72514 19.19334 23.33238 19.40728
## 9 17.81792 33.82406 28.96293 31.91232 30.96454 24.38654 37.18457 25.68798
## 10 18.61317 26.43717 33.14034 31.89648 23.93825 25.33373 27.87766 25.02444
## 11 19.34402 26.59649 29.13186 28.22814 20.94382 21.78586 26.52724 21.29873
## best_model
## 1 add.hw_a__dpr
## 2 nn
## 3 naive
## 4 add_mDOW.hw_m__DOW
## 5 add_mDOW.hw_a__dpr
## 6 add.hw_a__DOW
## 7 add_mDOW.hw_m__DOW
## 8 add.hw_a__DOW
## 9 add_mDOW.hw_m__DOW
## 10 add_mDOW.hw_m__DOW
## 11 add_mDOW.hw_m__DOW
#MAPE
## merge data set
final_result_MAPE<- essem_result_W_MAPE %>% merge(ts_models_result$MAPE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MAPE) <- sub("MAPE_", "", names(final_result_MAPE))
final_result_MAPE_W<- cbind(final_result_MAPE,best_model = colnames(final_result_MAPE)[apply(final_result_MAPE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MAPE_W
## forecast_period add mul add_mDOW add.hw_a__DOW
## 1 1m_Apr_out 0.7204192 0.4082786 0.4462765 0.4618744
## 2 1m_Dec_out 1.1429708 0.5855270 0.7133276 0.9803960
## 3 1m_Feb_out 0.4944848 0.3261111 0.2372792 0.2327433
## 4 1m_Jan_out 0.9591208 0.5148387 0.2567279 0.4759868
## 5 1m_Mar_out 0.4310890 0.3456033 0.1901021 0.2168089
## 6 1m_Nov_out 0.6679932 0.4369510 0.3044200 0.2642601
## 7 3m_Dec-Feb_out 1.1389898 0.6057732 0.5052288 0.7685826
## 8 3m_Feb-Apr_out 0.5000832 0.4317316 0.2504662 0.2407351
## 9 3m_Jan-Mar_out 0.7375085 0.5651368 0.2662024 0.3797336
## 10 3m_Nov-Jan_out 1.1995755 0.5476381 0.5145377 0.7213685
## 11 6m_Nov-Apr_out 1.0490212 0.5371790 0.4605074 0.6361491
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 0.4365694 0.4100690 0.4633880 0.4691924
## 2 0.7136787 0.9160451 0.7305441 0.7242297
## 3 0.2273784 0.2678228 0.2429558 0.2443128
## 4 0.2390497 0.3401160 0.2599070 0.2724014
## 5 0.1993218 0.2193402 0.1829251 0.1839134
## 6 0.2987081 0.4134716 0.3110600 0.3130031
## 7 0.4996686 0.7874182 0.5153887 0.5121320
## 8 0.2482957 0.2677531 0.2498110 0.2525296
## 9 0.2567542 0.3330343 0.2617064 0.2741617
## 10 0.5066025 0.7568129 0.5092670 0.5140099
## 11 0.4537934 0.6691622 0.4541670 0.4589474
## nn glm_st ses holt hw_add hw_mul Arima
## 1 0.5188506 0.4977434 0.9348579 0.9482544 0.6148652 0.6452088 0.7483806
## 2 0.4325117 0.6592069 1.2925213 1.2530115 1.2707635 1.2717348 1.0892604
## 3 0.2548241 0.4894489 0.4730915 0.4712047 0.2449163 0.2507572 0.3413123
## 4 0.3665313 1.1433150 0.7778604 0.6536619 0.4571971 0.4746228 0.4777408
## 5 0.2282606 0.5552950 0.4550559 0.4559024 0.2468240 0.2447211 0.2917256
## 6 0.3590767 0.4794062 0.7882818 0.7553887 0.3820458 0.4285194 0.5532158
## 7 0.3702050 0.7360310 1.0926923 1.0544110 0.8333053 0.8281398 0.9418174
## 8 0.2459431 0.5063005 0.5314595 0.5255231 0.3558995 0.3592458 0.4917265
## 9 0.2959928 0.8067058 0.5738793 0.5461635 0.5191572 0.4169745 0.5293566
## 10 0.3959824 0.7008228 1.2042130 1.1336424 0.8104840 0.9187168 0.8772148
## 11 0.3671218 0.6388567 0.9553429 0.8959336 0.5997629 0.6848645 0.7230100
## Sarima best_model
## 1 0.5815646 mul
## 2 1.3064874 nn
## 3 0.2609324 add_mDOW.hw_m__DOW
## 4 0.4729108 add_mDOW.hw_m__DOW
## 5 0.2317217 add_mDOW.hw_a__dpr
## 6 0.4104857 add.hw_a__DOW
## 7 0.8286613 nn
## 8 0.3589227 add.hw_a__DOW
## 9 0.4002496 add_mDOW.hw_m__DOW
## 10 0.8917202 nn
## 11 0.6557749 nn
#MASE
## merge data set
final_result_MASE<- essem_result_W_MASE %>% merge(ts_models_result$MASE,by="forecast_period",all=FALSE)
## rename columns
names(final_result_MASE) <- sub("MASE_", "", names(final_result_MASE))
final_result_MASE_W<- cbind(final_result_MASE,best_model = colnames(final_result_MASE)[apply(final_result_MASE,1,which.min)])
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
## Warning in FUN(newX[, i], ...): NAs introduced by coercion
final_result_MASE_W
## forecast_period add mul add_mDOW add.hw_a_DOW
## 1 1m_Apr_out 0.7081132 0.8752834 0.5493129 0.4612176
## 2 1m_Dec_out 1.0773652 0.8888382 0.7192616 0.9380362
## 3 1m_Feb_out 1.5764289 1.7326146 1.0643631 1.0332164
## 4 1m_Jan_out 1.6024864 1.6708715 0.5235568 0.8696352
## 5 1m_Mar_out 1.1074672 1.4239048 0.6987410 0.7572515
## 6 1m_Nov_out 1.0026685 1.0618178 0.5576923 0.4438397
## 7 3m_Dec-Feb_out 1.6148464 1.6305388 0.8356322 1.1575953
## 8 3m_Feb-Apr_out 1.2460076 1.7865418 0.9088421 0.8118265
## 9 3m_Jan-Mar_out 1.6672158 2.4757478 0.8900529 1.0384362
## 10 3m_Nov-Jan_out 1.4315150 1.2408567 0.7489421 0.9051263
## 11 6m_Nov-Apr_out 1.4720182 1.4935076 0.8058376 0.9496093
## add_mDOW.hw_m__DOW add.hw_a__dpr add_mDOW.hw_a__dpr add_mDOW.hw_m__dpr
## 1 0.5429767 0.4261956 0.5570260 0.5641355
## 2 0.7159523 0.8657702 0.7224171 0.7199996
## 3 1.0447277 1.1778253 1.0722922 1.0782831
## 4 0.5028740 1.0392916 0.5250065 0.5288059
## 5 0.7185551 0.7168770 0.6883915 0.6916710
## 6 0.5476166 0.7824874 0.5641313 0.5677400
## 7 0.8273532 1.1691002 0.8410748 0.8384347
## 8 0.9056134 0.9261265 0.9021830 0.9109923
## 9 0.8776063 1.4487387 0.8802505 0.8946424
## 10 0.7366745 1.0208403 0.7446655 0.7500758
## 11 0.7947976 1.0927242 0.8001538 0.8060053
## nn glm_st ses holt
## 1 0.6591353 0.6310732 0.862883557035178 0.870646128538007
## 2 0.5788589 0.8567301 1.20867897915411 1.18253756938824
## 3 1.1932359 1.8684303 0.539909198327349 0.590219869373757
## 4 1.0063348 2.1387228 1.51461459948899 1.4464104266271
## 5 0.8740461 1.4640783 1.29767225528038 1.29753915255108
## 6 0.7038541 0.7408904 1.12119051317152 1.11437240413335
## 7 0.8796837 1.3928263 1.60504186201305 1.57338646187902
## 8 0.9753623 1.4627824 1.2898960615447 1.32595706973114
## 9 1.1303523 2.1457667 1.78294381881824 1.96450677908921
## 10 0.7725194 1.0972456 1.42074162101984 1.36741660311895
## 11 0.8673714 1.1925669 1.3126381075586 1.27191747493191
## hw_add hw_mul Arima Sarima
## 1 0.564148231682622 0.565535116533899 0.755401242935939 0.551197655068417
## 2 1.16728704340749 1.16229916161656 1.02347369064707 1.20581754966476
## 3 0.34552033919289 0.369682990947948 0.435757623412606 0.379682774598811
## 4 1.24297305019322 1.14721773195554 1.50687212146416 1.25609650300468
## 5 0.869721349584206 0.88670257462673 1.0176449326799 0.892207532174453
## 6 0.71384406279644 0.686233451964408 1.01484252776394 0.695374142575834
## 7 1.24021917817597 1.23123977404581 1.45491867240685 1.24299822402762
## 8 0.843151851359788 0.912991470803143 1.10987817186834 0.923168199447218
## 9 1.90616194938938 1.50122333299401 1.85305151574134 1.58133921290795
## 10 1.02624367542471 1.08606865222246 1.19512784390653 1.07280898867372
## 11 0.943697112193449 0.981638060456886 1.19527754309856 0.959688942439446
## best_model
## 1 add.hw_a__dpr
## 2 nn
## 3 hw_add
## 4 add_mDOW.hw_m__DOW
## 5 add_mDOW.hw_a__dpr
## 6 add.hw_a_DOW
## 7 add_mDOW.hw_m__DOW
## 8 add.hw_a_DOW
## 9 add_mDOW.hw_m__DOW
## 10 add_mDOW.hw_m__DOW
## 11 add_mDOW.hw_m__DOW
write.csv(final_result_MASE_W,"final_result_comp_W")